#!/usr/bin/perl -w

#  Maemian -- Maemo package checker
# Copyright (C) Jeremiah C. Foster 2009, based on:

#   Maemian -- Debian package checker
# Copyright (C) 1998 Christian Schwarz and Richard Braakman
#
# This program is free software.  It is distributed 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, you can find it on the World Wide
# Web at http://www.gnu.org/copyleft/gpl.html, or write to the Free
# Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
# MA 02110-1301, USA.

=head1 NAME

maemian - Maemo package checker

=head1

Maemian is the maemo version of lintian - a policy checker designed to
assure the quality of a package uploaded into the maemo.org repositories.
The goal of maemian is to improve quality by checking that the maemo
packaging policy is followed. In order to do that it reads files in the
uploaded deb. Currently maemian only looks at the .dsc file and tries to
ascertain who uploaded it, and if they used the correct email address.

=cut

use strict;          # Warnings turned on via -w
use lib qw(lib/);
use Getopt::Long;

my $MAEMIAN_VERSION = "0.2";	    # External Version number (Where is the canonical version?)
my $BANNER = "Maemian v$MAEMIAN_VERSION";   # Version Banner - text form
my $LAB_FORMAT = 9;		            # Lab format Version Number
				            # increased whenever incompatible
				            # changes are done to the lab
				            # so that all packages are re-unpacked

# Variables used to record commandline options
# Commented out variables have "defined" checks somewhere to determine if
# they were set via commandline or environment variables
my $pkg_mode = 'a';		# auto -- automatically search for
				# binary and source pkgs
my $verbose = 0;		#flag for -v|--verbose switch
my $quiet = 0;			#flag for -q|--quiet switch
my @debug;
my $check_everything = 0;	#flag for -a|--all switch
my $maemian_info = 0;		#flag for -i|--info switch
our $display_experimentaltags = 0; #flag for -E|--display-experimental switch
our $display_pedantictags = 0;	#flag for --pedantic switch
my $unpack_level = undef;	#flag for -l|--unpack-level switch
our $no_override = 0;		#flag for -o|--no-override switch
our $show_overrides = 0;	#flag for --show-overrides switch
my $color = 'never';		#flag for --color switch
my $check_checksums = 0;	#flag for -m|--md5sums|--checksums switch
my $allow_root = 0;		#flag for --allow-root switch
my $fail_on_warnings = 0;       #flag for --fail-on-warnings switch
my $keep_lab = 0;		#flag for --keep-lab switch
my $packages_file = 0;		#string for the -p option
our $OPT_MAEMIAN_LAB = "";	#string for the --lab option
our $OPT_MAEMIAN_ARCHIVEDIR = "";#string for the --archivedir option
our $OPT_MAEMIAN_DIST = "";	#string for the --dist option
our $OPT_MAEMIAN_AREA = "";	#string for the --area option
# These options can also be used via default or environment variables
our $MAEMIAN_CFG = "";		#config file to use
our $MAEMIAN_ROOT = "/home/jeremiah/maemian/";	#location of the maemian modules
my $MAEMIAN_ARCH = "any";

my $experimental_output_opts = undef;

my @severities = qw(wishlist minor normal important serious);
my @certainties = qw(wild-guess possible certain);
my %display_level = ();
my %display_source = ();

my $schedule;

my $action;
my $checks;
my $check_tags;
my $dont_check;
my $unpack_info;
my $cwd;
my $cleanup_filename;
my $exit_code = 0;
my $LAB;

my %collection_info;
my %already_scheduled;
my %checks;
my %check_abbrev;
my %unpack_infos;
my %check_info;

# reset configuration variables
our $MAEMIAN_LAB = undef;
our $MAEMIAN_ARCHIVEDIR = undef;
our $MAEMIAN_DIST = undef;
our $MAEMIAN_UNPACK_LEVEL = undef;
our $MAEMIAN_SECTION = undef;
our $MAEMIAN_AREA = undef;

#turn off file buffering
$| = 1;

# reset locale definition (necessary for tar)
$ENV{'LC_ALL'} = 'C';
# reset timezone definition (also for tar)
$ENV{'TZ'}     = '';

# }}}

# {{{ Process Command Line

#######################################
# Subroutines called by various options
# in the options hash below.  These are
# invoked to process the commandline
# options
#######################################
# Display Command Syntax
# Options: -h|--help
sub syntax {
    print "$BANNER\n";
    print <<"EOT-EOT-EOT";
Syntax: maemian [action] [options] [--] [packages] ...
Actions:
    -S, --setup-lab           set up static lab
    -R, --remove-lab          remove static lab
    -c, --check               check packages (default action)
    -C X, --check-part X      check only certain aspects
    -X X, --dont-check-part X don\'t check certain aspects
    -T X, --tags X            only run checks needed for requested tags
    --tags-from-file X        like --tags, but read list from file
    -u, --unpack              only unpack packages in the lab
    -r, --remove              remove package from the lab
General options:
    -h, --help                display short help text
    -v, --verbose             verbose messages
    -V, --version             display Maemian version and exit
    --print-version           print unadorned version number and exit
    -d, --debug               turn Maemian\'s debug messages ON
    -q, --quiet               suppress all informational messages
Behaviour options:
    -i, --info                give detailed info about tags
    -I, --display-info        display "I:" tags (normally suppressed)
    -E, --display-experimental display "X:" tags (normally suppressed)
    --pedantic                display "P:" tags (normally suppressed)
    -L, --display-level       display tags with the specified level
    --display-source X        restrict displayed tags by source
    -l X, --unpack-level X    set default unpack level to X
    -o, --no-override         ignore overrides
    --show-overrides          output tags that have been overriden
    --color never/always/auto disable, enable, or enable color for TTY
    -U X, --unpack-info X     specify which info should be collected
    -m, --md5sums, --checksums check checksums when processing a .changes file
    --allow-root              suppress maemian\'s warning when run as root
    --fail-on-warnings        return a non-zero exit status if warnings found
    --keep-lab                keep lab after run, even if temporary
Configuration options:
    --cfg CONFIGFILE          read CONFIGFILE for configuration
    --lab LABDIR              use LABDIR as permanent laboratory
    --archivedir ARCHIVEDIR   location of Debian archive to scan for packages
    --dist DIST               scan packages in this distribution (e.g. sid)
    --area AREA               scan packages in this archive area (e.g. main)
    --arch ARCH               scan packages with architecture ARCH
    --root ROOTDIR            use ROOTDIR instead of /usr/share/maemian
Package selection options:
    -a, --all                 process all packages in distribution
    -b, --binary              process only binary packages
    -s, --source              process only source packages
    --udeb                    process only udeb packages
    -p X, --packages-file X   process all files in file (special syntax!)
EOT-EOT-EOT

    exit 0;
}

# Display Version Banner
# Options: -V|--version, --print-version
sub banner {
  if ($_[0] eq 'print-version') {
    print "$MAEMIAN_VERSION\n";
  } else {
    print "$BANNER\n";
  }
  exit 0;
}

# Record action requested
# Options: -S, -R, -c, -u, -r
sub record_action {
  if ($action) {
    die("too many actions specified: $_[0]");
  }
  $action = "$_[0]";
}

# Record Parts requested for checking
# Options: -C|--check-part
sub record_check_part {
  if (defined $action and $action eq 'check' and $checks) {
    die("multiple -C or --check-part options not allowed");
  }
  if ($dont_check) {
    die("both -C or --check-part and -X or --dont-check-part options not allowed");
  }
  if ($action) {
    die("too many actions specified: $_[0]");
  }
  $action = 'check';
  $checks = "$_[1]";
}

# Record Parts requested for checking
# Options: -T|--tags
sub record_check_tags {
    if (defined $action and $action eq 'check' and $check_tags) {
	die("multiple -T or --tags options not allowed");
    }
    if ($checks) {
	die("both -T or --tags and -C or --check-part options not allowed");
    }
    if ($dont_check) {
	die("both -T or --tags and -X or --dont-check-part options not allowed");
    }
    if ($action) {
	die("too many actions specified: $_[0]");
    }
    $action = 'check';
    $check_tags = "$_[1]";
}

# Record Parts requested for checking
# Options: --tags-from-file
sub record_check_tags_from_file {
    open my $file, '<', $_[1]
	or fail("failed to open $_[1]: $!");
    my $tags =  join(',', map { chomp($_); $_ } <$file>);
    close $file;

    record_check_tags($_[0], $tags);
}


# Record Parts requested not to check
# Options: -X|--dont-check-part X
sub record_dont_check_part {
    if (defined $action and $action eq 'check' and $dont_check) {
	die("multiple -X or --dont-check-part options not allowed");
    }
    if ($checks) {
	die("both -C or --check-part and -X or --dont-check-part options not allowed");
    }
    if ($action) {
	die("too many actions specified: $_[0]");
    }
    $action = 'check';
    $dont_check = "$_[1]";
}


# Process for -U|--unpack-info flag
sub record_unpack_info {
    if ($unpack_info) {
	die("multiple -U or --unpack-info options not allowed");
    }
    $unpack_info = "$_[1]";
}

# Record what type of data is specified
# Options: -b|--binary, -s|--source, --udeb
sub record_pkgmode {
    $pkg_mode = 'b' if $_[0] eq 'binary';
    $pkg_mode = 's' if $_[0] eq 'source';
    $pkg_mode = 'u' if $_[0] eq 'udeb';
}

# Process -L|--display-level flag
sub record_display_level {
    my $level = $_[1];
    if ($level =~ m/^\+(.+)/) {
	set_display_level($1, 1);
    } elsif ($level =~ m/^\-(.+)/) {
	set_display_level($1, 0);
    } elsif ($level =~ m/^\=?(.+)/) {
	reset_display_level();
	set_display_level($1, 1);
    } else {
	die "invalid argument to --display-level: $level\n";
    }
}

# Process -I|--display-info flag
sub display_infotags {
    foreach my $s (@severities) {
	set_display_level($s, 1);
    }
}

# Process --display-source flag
sub record_display_source {
    $display_source{$_[1]} = 1;
}

# Clears current display level information, disabling all severities and
# certainties
sub reset_display_level {
    foreach my $s (@severities) {
	foreach my $c (@certainties) {
	    $display_level{$s}{$c} = 0;
	}
    }
}

sub set_display_level_multi {
    my ($op, $level, $val) = @_;

    my @inc_severities = @severities;
    my @inc_certainties = @certainties;
    my $inc_border = ($op =~ /^[<>]=$/) ? 1 : 0;
    if ($op =~ /^>/) {
	@inc_severities = reverse @inc_severities;
	@inc_certainties = reverse @inc_certainties;
    }
    my $severity = join("|", @severities);
    my $certainty = join("|", @certainties);
    if ($level =~ m/^($severity)$/) {
	foreach my $s (cut_list($level, $inc_border, @inc_severities)) {
	    map { $display_level{$s}{$_} = $val } @certainties;
	}
    } elsif ($level =~ m/^($certainty)$/) {
	foreach my $c (cut_list($level, $inc_border, @inc_certainties)) {
	    map { $display_level{$_}{$c} = $val } @severities;
	}
    } elsif ($level =~ m/^($severity)\/($certainty)$/) {
	foreach my $s (cut_list($1, $inc_border, @inc_severities)) {
	    foreach my $c (cut_list($2, $inc_border, @inc_certainties)) {
		$display_level{$s}{$c} = $val;
	    }
	}
    } else {
	die "invalid argument to --display-level: $level\n";
    }

}

sub cut_list {
    my ($border, $inc_border, @list) = @_;

    my (@newlist, $found);
    foreach (@list) {
	if ($_ eq $border) {
	    push @newlist, $_ if $inc_border;
	    $found = 1;
	    last;
	} else {
	    push @newlist, $_;
	}
    }
    die "internal error: cut_list did not find border $border\n"
	unless $found;
    if (!$inc_border and !@newlist
	and $border eq $list[0]) {
	warn "warning: display level $border specified with > (or <) is empty set, assuming >= (or <=)\n";
	push @newlist, $list[0];
    }

    return @newlist;
}

# Parse input display level to enable (val 1) or disable (val 0) it
# accordingly
sub set_display_level {
    my ($level, $val) = @_;
    if ($level =~ m/^([<>]=?)(.+)/) {
	set_display_level_multi($1, $2, $val);
	return;
    }

    my $severity = join("|", @severities);
    my $certainty = join("|", @certainties);
    if ($level =~ m/^($severity)$/) {
	map { $display_level{$1}{$_} = $val } @certainties;
    } elsif ($level =~ m/^($certainty)$/) {
	map { $display_level{$_}{$1} = $val } @severities;
    } elsif ($level =~ m/^($severity)\/($certainty)$/) {
	$display_level{$1}{$2} = $val;
    } else {
	die "invalid argument to --display-level: $level\n";
    }
}

# Hash used to process commandline options
my %opthash = (
	       # ------------------ actions
	       "setup-lab|S" => \&record_action,
	       "remove-lab|R" => \&record_action,
	       "check|c" => \&record_action,
	       "check-part|C=s" => \&record_check_part,
	       "tags|T=s" => \&record_check_tags,
	       "tags-from-file=s" => \&record_check_tags_from_file,
	       "dont-check-part|X=s" => \&record_dont_check_part,
	       "unpack|u" => \&record_action,
	       "remove|r" => \&record_action,

	       # ------------------ general options
	       "help|h" => \&syntax,
	       "version|V" => \&banner,
	       "print-version" => \&banner,

	       "verbose|v" => \$verbose,
	       "debug|d" => \@debug, # Count the -d flags
	       "quiet|q" => \$quiet,

	       # ------------------ behaviour options
	       "info|i" => \$maemian_info,
	       "display-info|I" => \&display_infotags,
	       "display-experimental|E" => \$display_experimentaltags,
	       "pedantic" => \$display_pedantictags,
	       "display-level|L=s" => \&record_display_level,
	       "display-source=s" => \&record_display_source,
	       "unpack-level|l=i" => \$unpack_level,
	       "no-override|o" => \$no_override,
	       "show-overrides" => \$show_overrides,
	       "color=s" => \$color,
	       "unpack-info|U=s" => \&record_unpack_info,
	       "checksums|md5sums|m" => \$check_checksums,
	       "allow-root" => \$allow_root,
	       "fail-on-warnings" => \$fail_on_warnings,
	       "keep-lab" => \$keep_lab,
	       # Note: Ubuntu has (and other derivatives might gain) a
	       # -D/--debian option to make maemian behave like in Debian, that
	       # is, to revert distribution-specific changes

	       # ------------------ configuration options
	       "cfg=s" => \$MAEMIAN_CFG,
	       "lab=s" => \$OPT_MAEMIAN_LAB,
	       "archivedir=s" => \$OPT_MAEMIAN_ARCHIVEDIR,
	       "dist=s" => \$OPT_MAEMIAN_DIST,
	       "area=s" => \$OPT_MAEMIAN_AREA,
	       "section=s" => \$OPT_MAEMIAN_AREA,
	       "root=s" => \$MAEMIAN_ROOT,

	       # ------------------ package selection options
	       "all|a" => \$check_everything,
	       "binary|b" => \&record_pkgmode,
	       "source|s" => \&record_pkgmode,
	       "udeb" => \&record_pkgmode,
	       "packages-file|p=s" => \$packages_file,

	       # ------------------ experimental
	       "exp-output:s" => \$experimental_output_opts,
	      );

# init display level settings
reset_display_level();
set_display_level_multi('>=', 'important', 1);
set_display_level_multi('>=', 'normal/possible', 1);
set_display_level('minor/certain', 1);

# init commandline parser
Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev');

# process commandline options
GetOptions(%opthash)
    or die("error parsing options\n");

# determine current working directory--we'll need this later
chop($cwd = `pwd`);

# determine MAEMIAN_ROOT if it was not set with --root.
$MAEMIAN_ROOT = $MAEMIAN_ROOT || $ENV{'MAEMIAN_ROOT'};
if (defined $MAEMIAN_ROOT) {
    unless ($MAEMIAN_ROOT =~ m,^/,) {
	$MAEMIAN_ROOT = "$cwd/$MAEMIAN_ROOT";
    }
} else {
    $MAEMIAN_ROOT = '/usr/share/maemian';
}

# keep-lab implies unpack-level=2 unless explicetly
# given otherwise
if ($keep_lab and not defined $unpack_level) {
    $unpack_level = 2;
}

# option --all and packages specified at the same time?
if (($check_everything or $packages_file) and $#ARGV+1 > 0) {
    print STDERR "warning: options -a or -p can't be mixed with package parameters!\n";
    print STDERR "(will ignore -a or -p option)\n";
    undef $check_everything;
    undef $packages_file;
}

# check permitted values for --color
if ($color and $color !~ /^(never|always|auto|html)$/) {
    die "invalid argument to --color: $color\n";
}

# check specified action
$action = 'check' unless $action;

# check for arguments
if ($action =~ /^(check|unpack|remove)$/ and $#ARGV == -1 and not $check_everything and not $packages_file) {
    syntax();
}

# }}}

# {{{ Setup Configuration
#
# root permissions?
# check if effective UID is 0
if ($> == 0 and not $allow_root) {
    print STDERR "warning: maemian's authors do not recommend running it with root privileges!\n";
}

# search for configuration file if it was not set with --cfg
# do not search the default locations if it was set.
if ($MAEMIAN_CFG) {
} elsif (exists $ENV{'MAEMIAN_CFG'} &&
	 -f ($MAEMIAN_CFG = $ENV{'MAEMIAN_CFG'})) {
} elsif (-f ($MAEMIAN_CFG = $MAEMIAN_ROOT . '/maemianrc')) {
} elsif (exists $ENV{'HOME'} &&
	 -f ($MAEMIAN_CFG = $ENV{'HOME'} . '/.maemianrc')) {
} elsif (-f ($MAEMIAN_CFG = '/etc/maemianrc')) {
} else {
    undef $MAEMIAN_CFG;
}

use constant VARS => qw(LAB ARCHIVEDIR DIST UNPACK_LEVEL SECTION AREA ARCH);
# read configuration file
if ($MAEMIAN_CFG) {
    open(CFG, '<', $MAEMIAN_CFG)
	or die("cannot open configuration file $MAEMIAN_CFG for reading: $!");
    while (<CFG>) {
	chop;
	s/\#.*$//go;
	s/\"//go;
	next if m/^\s*$/o;

	# substitute some special variables
	s,\$HOME/,$ENV{'HOME'}/,go;
	s,\~/,$ENV{'HOME'}/,go;

	my $found = 0;
	foreach my $var (VARS) {
	    no strict 'refs';
	    $var = "MAEMIAN_$var";
	    if (m/^\s*$var\s*=\s*(.*\S)\s*$/i) {
		$$var = $1;
		$found = 1;
		last;
	    }
	}
	unless ($found) {
	    die "syntax error in configuration file: $_\n";
	}
    }
    close(CFG);
}

# environment variables overwrite settings in conf file:
foreach (VARS) {
    no strict 'refs';
    my $var = "MAEMIAN_$_";
    my $opt_var = "OPT_$var";
    $$var = $ENV{$var} if $ENV{$var};
    $$var = $$opt_var if $$opt_var;
}

# MAEMIAN_SECTION is deprecated in favour of MAEMIAN_AREA
if (defined $MAEMIAN_SECTION) {
    print STDERR "warning: MAEMIAN_SECTION has been deprecated in favour of MAEMIAN_AREA.\n";
    if (defined $MAEMIAN_AREA) {
	print STDERR "Using MAEMIAN_AREA as both were defined.\n";
    } else {
	print STDERR "Both are currently accepted, but MAEMIAN_SECTION may be removed\n";
	print STDERR "in a future Maemian release.\n";
	$MAEMIAN_AREA = $MAEMIAN_SECTION;
    }
}

# determine requested unpack level
if (defined($unpack_level)) {
    # specified through command line
} elsif (defined($MAEMIAN_UNPACK_LEVEL)) {
    # specified via configuration file or env variable
    $unpack_level = $MAEMIAN_UNPACK_LEVEL;
} else {
    # determine by action
    if (($action eq 'unpack') or ($action eq 'check')) {
	$unpack_level = 1;
    } else {
	$unpack_level = 0;
    }
}
unless (($unpack_level == 0) or ($unpack_level == 1) or ($unpack_level == 2)) {
    die("bad unpack level $unpack_level specified");
}

$MAEMIAN_UNPACK_LEVEL = $unpack_level;

# export current settings for our helper scripts
foreach (('ROOT', 'CFG', VARS)) {
    no strict 'refs';
    my $var = "MAEMIAN_$_";
    if ($$var) {
	$ENV{$var} = $$var;
    } else {
	$ENV{$var} = "";
	$$var = "";
    }
}

my $debug = $#debug + 1;
$verbose = 1 if $debug;
$ENV{'MAEMIAN_DEBUG'} = $debug;

#  Loading maeian's own libraries (now that MAEMIAN_ROOT is known)
unshift @INC, "$MAEMIAN_ROOT/lib";

require Lab;

require Util;
require Read_pkglists;

import Util;

require Tags;
import Tags;

require Maemian::Data;
require Maemian::Schedule;
require Maemian::Output;
import Maemian::Output qw(:messages);
require Maemian::Command;
import Maemian::Command qw(spawn reap);
require Maemian::Check;
import Maemian::Check qw(check_maintainer);

no warnings 'once';
if (defined $experimental_output_opts) {
    my %opts = map { split(/=/) } split( /,/, $experimental_output_opts );
    foreach (keys %opts) {
	if ($_ eq 'format') {
	    if ($opts{$_} eq 'colons') {
		require Maemian::Output::ColonSeparated;
		$Maemian::Output::GLOBAL = new Maemian::Output::ColonSeparated;
	    } elsif ($opts{$_} eq 'letterqualifier') {
		require Maemian::Output::LetterQualifier;
		$Maemian::Output::GLOBAL = new Maemian::Output::LetterQualifier;
	    } elsif ($opts{$_} eq 'xml') {
		require Maemian::Output::XML;
		$Maemian::Output::GLOBAL = new Maemian::Output::XML;
	    }
	}
	no strict 'refs';
	${"Tags::$_"} = $opts{$_};
    }
}

$Maemian::Output::GLOBAL->verbose($verbose);
$Maemian::Output::GLOBAL->debug($debug);
$Maemian::Output::GLOBAL->quiet($quiet);
$Maemian::Output::GLOBAL->color($color);
$Maemian::Output::GLOBAL->showdescription($maemian_info);

# Print Debug banner, now that we're finished determining
# the values and have Maemian::Output available
debug_msg(1,
	  $BANNER,
	  "Maemian root directory: $MAEMIAN_ROOT",
	  "Configuration file: $MAEMIAN_CFG",
	  "Laboratory: $MAEMIAN_LAB",
	  "Archive directory: $MAEMIAN_ARCHIVEDIR",
	  "Distribution: $MAEMIAN_DIST",
	  "Default unpack level: $MAEMIAN_UNPACK_LEVEL",
	  "Architecture: $MAEMIAN_ARCH",
	  delimiter(),
    );

my @l_secs = read_dpkg_control("$MAEMIAN_ROOT/checks/maemian.desc");
shift(@l_secs);
map { $_->{'script'} = 'maemian'; Tags::add_tag($_) } @l_secs;

$Tags::show_experimental = $display_experimentaltags;
$Tags::show_pedantic = $display_pedantictags;
$Tags::show_overrides = $show_overrides;
%Tags::display_level = %display_level;
%Tags::display_source = %display_source;
%Tags::only_issue_tags = map { $_ => 1 } (split(/,/, $check_tags))
  
  if defined $check_tags;
use warnings;
use vars qw(%source_info %binary_info %udeb_info); # from the above

# Set up clean-up handlers.
undef $cleanup_filename;
$SIG{'INT'} = \&interrupted;
$SIG{'QUIT'} = \&interrupted;

# }}}

# {{{ Create/Maintain Lab and add any specified Debian Archives (*.debs)

$LAB = new Lab( $MAEMIAN_LAB, $MAEMIAN_DIST );

#######################################
# Process -S option
if ($action eq 'setup-lab') {
    if ($#ARGV+1 > 0) { # Cannot define Lab on the command line. 
	warning("ignoring additional command line arguments");
    }

    $LAB->setup_static()
	or fail("There was an error while setting up the static lab.");

    exit 0;

#######################################
# Process -R option
} elsif ($action eq 'remove-lab') {
    if ($#ARGV+1 > 0) {
	warning("ignoring additional command line arguments");
    }

    $LAB->delete_static()
	or fail("There was an error while removing the static lab.");

    exit 0;

#######################################
#  Check for non deb specific actions
} elsif (not (($action eq 'unpack') or ($action eq 'check')
	      or ($action eq 'remove'))) {
    fail("bad action $action specified");
}

# sanity check:
fail("maemian lab has not been set up correctly (perhaps you forgot to run maemian --setup-lab?)")
    unless $LAB->is_lab();

#XXX: There has to be a cleaner way to do this
$MAEMIAN_LAB = $LAB->{dir};

# }}}

# {{{ Compile list of files to process

$schedule = new Maemian::Schedule(verbose => $verbose);
# process package/file arguments
while (my $arg = shift) {
    # file?
    if (-f $arg) {
	# $arg contains absolute dir spec?
	unless ($arg =~ m,^/,) {
	    $arg = "$cwd/$arg";
	}

	# .deb file?
	if ($arg =~ /\.deb$/) {
	    $schedule->add_deb('b', $arg)
		or warning("$arg is a zero-byte file, skipping");
	}
	# .udeb file?
	elsif ($arg =~ /\.udeb$/) {
	    $schedule->add_deb('u', $arg)
		or warning("$arg is a zero-byte file, skipping");
	}
	# .dsc file?
	elsif ($arg =~ /\.dsc$/) {
	    $schedule->add_dsc($arg)
		or warning("$arg is a zero-byte file, skipping");
	}
	# .changes file?
	elsif ($arg =~ /\.changes$/) {
	    # get directory and filename part of $arg
	    my ($arg_dir, $arg_name) = $arg =~ m,(.*)/([^/]+)$,;

	    v_msg("Processing changes file $arg_name ...");

	    my ($data) = read_dpkg_control($arg);
	    if (not defined $data) {
		warning("$arg is a zero-byte file, skipping");
		next;
	    }
	    Tags::set_pkg( $arg, $arg_name, "", "", 'binary' );

	    # If we don't have a Format key, something went seriously wrong.
	    # Tag the file and skip remaining processing.
	    if (!$data->{'format'}) {
		tag('malformed-changes-file');
		next;
	    }

	    # Description is mandated by dak, but only makes sense if binary
	    # packages are included.  Don't tag pure source uploads.
	    if (!$data->{'description'} && $data->{'architecture'} ne 'source') {
		tag("no-description-in-changes-file");
	    }

	    # check distribution field
	    if (defined $data->{distribution}) {
		my $ubuntu_dists = Maemian::Data->new ('changelog-file/ubuntu-dists');
		my $ubuntu_regex = join('|', $ubuntu_dists->all);
		my @distributions = split /\s+/o, $data->{distribution};
		for my $distribution (@distributions) {
		    if ($distribution eq 'UNRELEASED') {
			# ignore
		    } elsif ($data->{version} =~ /ubuntu|$ubuntu_regex/
			 or $distribution =~ /$ubuntu_regex/) {
			if ($distribution !~ /^($ubuntu_regex)(-(proposed|updates|backports|security))?$/ ) {
			    tag("bad-ubuntu-distribution-in-changes-file",
				$distribution);
			}
		    } elsif (! (($distribution eq 'oldstable')
				 or ($distribution eq 'stable')
				 or ($distribution eq 'testing')
				 or ($distribution eq 'unstable')
				 or ($distribution eq 'experimental')
				 or ($distribution =~ /^\w+-backports$/)
				 or ($distribution =~ /^\w+-proposed-updates$/)
				 or ($distribution =~ /^\w+-security$/))
			    ) {
			# bad distribution entry
			tag("bad-distribution-in-changes-file",
			    $distribution);
		    }
		}

		if ($#distributions > 0) {
		    # Currently disabled until dak stops accepting the syntax
		    # tag("multiple-distributions-in-changes-file",
		    #    $data->{'distribution'});
		}
	    }

	    # Urgency is only recommended by Policy.
	    if (!$data->{'urgency'}) {
		tag("no-urgency-in-changes-file");
	    } else {
		my $urgency = lc $data->{'urgency'};
		$urgency =~ s/ .*//;
		unless ($urgency =~ /^(low|medium|high|critical|emergency)$/i) {
		    tag("bad-urgency-in-changes-file", $data->{'urgency'});
		}
	    }

	    # Changed-By is optional in Policy, but if set, must be
	    # syntactically correct.  It's also used by dak.
	    if ($data->{'changed-by'}) {
		check_maintainer($data->{'changed-by'}, 'changed-by');
	    }

	    # process all listed `files:'
	    my %files;

	    my $file_list = $data->{files} || '';
	    for ( split /\n/, $file_list ) {
		chomp;
		s/^\s+//o;
		next if $_ eq '';

		my ($md5sum,$size,$section,$priority,$file) = split(/\s+/o, $_);
		$files{$file}{md5} = $md5sum;
		$files{$file}{size} = $size;

		# check section
		if (($section eq 'non-free') or ($section eq 'contrib')) {
		    tag( "bad-section-in-changes-file", $file, $section );
		}

	    }

	    foreach my $alg (qw(sha1 sha256)) {
		my $list = $data->{"checksums-$alg"} || '';
		for ( split /\n/, $list ) {
		    chomp;
		    s/^\s+//o;
		    next if $_ eq '';

		    my ($checksum,$size,$file) = split(/\s+/o, $_);
		    $files{$file}{$alg} = $checksum;
		    if ($files{$file}{size} != $size) {
			tag( "file-size-mismatch-in-changes-file", $file,
			     "$files{$file}{size} != $size" );
		    }
		}
	    }


	    foreach my $file (keys %files) {
		my $filename = $arg_dir . '/' . $file;

		# check size
		if (not -f $filename) {
		    warning("$file does not exist, exiting");
		    exit 2;
		}
		my $size = -s _;
		if ($size ne $files{$file}{size}) {
		    tag( "file-size-mismatch-in-changes-file", $file,
			 "$files{$file}{size} != $size");
		}

		# check checksums
		if ($check_checksums or $file =~ /\.dsc$/) {
		    foreach my $alg (qw(md5 sha1 sha256)) {
			next unless exists $files{$file}{$alg};

			my $real_checksum = get_file_checksum($alg, $filename);

			if ($real_checksum ne $files{$file}{$alg}) {
			    tag( "checksum-mismatch-in-changes-file", $alg, $file );
			}
		    }
		}

		# process file?
		if ($file =~ /\.dsc$/) {
		    $schedule->add_dsc($filename);
		} elsif ($file =~ /\.deb$/) {
		    $schedule->add_deb('b', $filename);
		} elsif ($file =~ /\.udeb$/) {
		    $schedule->add_deb('u', $filename);
		}
	    }

	    unless ($exit_code) {
		my $stats = Tags::get_stats( $arg );
		if ($stats->{types}{E}) {
		    $exit_code = 1;
		} elsif ($fail_on_warnings && $stats->{types}{W}) {
		    $exit_code = 1;
		}
	    }

	} else {
	    fail("bad package file name $arg (neither .deb, .udeb or .dsc file)");
	}
    } else {
	# parameter is a package name--so look it up
	# search the distribution first, then the lab
	# special case: search only in lab if action is `remove'

	my $search;
	if ($action eq 'remove') {
	    # search only in lab--see below
	    $search = 'lab';
	} else {
	    # search in dist, then in lab
	    $search = 'dist or lab';

	    my $found = 0;

	    # read package info
	    read_src_list("$MAEMIAN_LAB/info/source-packages", 0);
	    read_bin_list("$MAEMIAN_LAB/info/binary-packages", 0);
	    read_udeb_list("$MAEMIAN_LAB/info/udeb-packages", 0);

	    if (($pkg_mode eq 'b') or ($pkg_mode eq 'a')) {
		if ($binary_info{$arg}) {
		    $schedule->add_file('b', "$MAEMIAN_ARCHIVEDIR/$binary_info{$arg}->{'file'}",
					%{$binary_info{$arg}});
		    $found = 1;
		}
	    }
	    if (($pkg_mode eq 'u') or ($pkg_mode eq 'a')) {
		if ($udeb_info{$arg}) {
		    $schedule->add_file('u', "$MAEMIAN_ARCHIVEDIR/$udeb_info{$arg}->{'file'}",
					%{$udeb_info{$arg}});
		    $found = 1;
		}
	    }
	    if (($pkg_mode eq 's') or ($pkg_mode eq 'a')) {
		if ($source_info{$arg}) {
		    $schedule->add_file('s', "$MAEMIAN_ARCHIVEDIR/$source_info{$arg}->{'file'}",
					%{$source_info{$arg}});
		    $found = 1;
		}
	    }

	    next if $found;
	}

	# nothing found so far, so search the lab

	my $b = "$MAEMIAN_LAB/binary/$arg";
	my $s = "$MAEMIAN_LAB/source/$arg";
	my $u = "$MAEMIAN_LAB/udeb/$arg";

	if ($pkg_mode eq 'b') {
	    unless (-d $b) {
		warn "error: cannot find binary package $arg in $search (skipping)\n";
		$exit_code = 2;
		next;
	    }
	} elsif ($pkg_mode eq 's') {
	    unless (-d $s) {
		warning("cannot find source package $arg in $search (skipping)");
		$exit_code = 2;
		next;
	    }
	} elsif ($pkg_mode eq 'u') {
	    unless (-d $u) {
		warning("cannot find udeb package $arg in $search (skipping)");
		$exit_code = 2;
		next;
	    }
	} else {
	    # $pkg_mode eq 'a'
	    unless (-d $b or -d $s or -d $u) {
		warning("cannot find binary, udeb or source package $arg in $search (skipping)");
		$exit_code = 2;
		next;
	    }
	}

	if (($pkg_mode eq 'b') or (($pkg_mode eq 'a') and (-d $b))) {
	    $schedule->add_file('b', get_bin_info_from_lab($b));
	}
	if (($pkg_mode eq 's') or (($pkg_mode eq 'a') and (-d $s))) {
	    $schedule->add_file('s', get_src_info_from_lab($s));
	}
	if (($pkg_mode eq 'u') or (($pkg_mode eq 'a') and (-d $u))) {
	    $schedule->add_file('u', get_bin_info_from_lab($u));
	}
    }
}

if (not $check_everything and not $packages_file and not $schedule->count) {
    v_msg("No packages selected.");
    exit $exit_code;
}

#  Check to make sure there are packages to check.
sub set_value {
    my ($f,$target,$field,$source,$required) = @_;
    use YAML;
#    print map { Dump($_) } @_;
    if ($required and not $source->{$field}) {
      print Dump($f)."\n";
      fail("description file $f does not define required tag $field");
    }
    $target->{$field} = $source->{$field};
    delete $source->{$field};
}

opendir(COLLDIR, "$MAEMIAN_ROOT/collection")
    or fail("cannot read directory $MAEMIAN_ROOT/collection");

for my $f (readdir COLLDIR) {
    next if $f =~ /^\./;
    next unless $f =~ /\.desc$/;

    debug_msg(2, "Reading collector description file $f ...");
    my @secs = read_dpkg_control("$MAEMIAN_ROOT/collection/$f");
    my $script;
    ($#secs+1 == 1)
	or fail("syntax error in description file $f: too many sections");

    ($script = $secs[0]->{'collector-script'})
	or fail("error in description file $f: `Collector-Script:' not defined");

    delete $secs[0]->{'collector-script'};
    $collection_info{$script}->{'script'} = $script;
    my $p = $collection_info{$script};

    set_value($f, $p,'type',$secs[0],1);
    # convert Type:
    my ($b,$s,$u) = ( "", "", "" );;
    for (split(/\s*,\s*/o,$p->{'type'})) {
	if ($_ eq 'binary') {
	    $b = 'b';
	} elsif ($_ eq 'source') {
	    $s = 's';
	} elsif ($_ eq 'udeb') {
	    $u = 'u';
	} else {
	    fail("unknown type $_ specified in description file $f");
	}
    }
    $p->{'type'} = "$s$b$u";

    set_value($f,$p,'unpack-level',$secs[0],1);
    set_value($f,$p,'order',$secs[0],1);
    set_value($f,$p,'version',$secs[0],1);

    if (exists $secs[0]->{'needs-info'} && defined $secs[0]->{'needs-info'}) {
	for (split(/\s*,\s*/o,$secs[0]->{'needs-info'})) {
	    $p->{$_} = 1;
	}
	delete $secs[0]->{'needs-info'};
    }

    # ignore Info: and other fields for now
    delete $secs[0]->{'info'};
    delete $secs[0]->{'author'};

    for (keys %{$secs[0]}) {
	warning("unused tag $_ in description file $f");
    }

    debug_msg(2, map( { "$_: $p->{$_}" } sort keys %$p ));
}

closedir(COLLDIR);
# }}}

# {{{ Now we're ready to load info about checks & tags

# load information about checker scripts
opendir(CHECKDIR, "$MAEMIAN_ROOT/checks")
    or fail("cannot read directory $MAEMIAN_ROOT/checks");

for my $f (readdir CHECKDIR) {
    next if $f =~ /^\./;
    next unless $f =~ /\.desc$/;
    debug_msg(2, "Reading checker description file $f ...");

    my @secs = read_dpkg_control("$MAEMIAN_ROOT/checks/$f");
    my $script;
    ($script = $secs[0]->{'check-script'})
	or fail("error in description file $f: `Check-Script:' not defined");

    # ignore check `maemian' (this check is a special case and contains the
    # tag info for the maemian frontend--this script here)
    next if $script eq 'maemian';

    delete $secs[0]->{'check-script'};
    $check_info{$script}->{'script'} = $script;
    my $p = $check_info{$script};

    set_value($f,$p,'type',$secs[0],1);
    # convert Type:
    my ($b,$s,$u) = ( "", "", "" );
    for (split(/\s*,\s*/o,$p->{'type'})) {
	if ($_ eq 'binary') {
	    $b = 'b';
	} elsif ($_ eq 'source') {
	    $s = 's';
	} elsif ($_ eq 'udeb') {
	    $u = 'u';
	} else {
	    fail("unknown type $_ specified in description file $f");
	}
    }
    $p->{'type'} = "$s$b$u";

    set_value($f,$p,'unpack-level',$secs[0],1);
    set_value($f,$p,'abbrev',$secs[0],1);

    if (exists $secs[0]->{'needs-info'} && defined $secs[0]->{'needs-info'}) {
	for (split(/\s*,\s*/o,$secs[0]->{'needs-info'})) {
	    $p->{$_} = 1;
	}
	delete $secs[0]->{'needs-info'};
    }

    # ignore Info: and other fields for now...
    delete $secs[0]->{'info'};
    delete $secs[0]->{'standards-version'};
    delete $secs[0]->{'author'};

    for (keys %{$secs[0]}) {
	warning("unused tag $_ in description file $f");
    }

    debug_msg(2, map( { "$_: $p->{$_}" } sort keys %$p ));

    shift(@secs);
    $p->{'requested-tags'} = 0;
    foreach my $tag (@secs) {
	$tag->{'script'} = $script;
	Tags::add_tag($tag);
	$p->{'requested-tags'}++ if Tags::display_tag($tag);
    }
}

closedir(CHECKDIR);

# }}}

# {{{ Again some lone code the author just dumped where his cursor just happened to be
if ($unpack_info) {
    # determine which info has been requested
    for my $i (split(/,/,$unpack_info)) {
	unless ($collection_info{$i}) {
	    fail("unknown info specified: $i");
	}
	$unpack_infos{$i} = 1;
    }
}

# create check_abbrev hash
for my $c (keys %check_info) {
    $check_abbrev{$check_info{$c}->{'abbrev'}} = $c;
}

# }}}

# {{{ determine which checks have been requested
if ($action eq 'check') {
    if ($check_tags) {
	foreach my $t (split(/,/, $check_tags)) {
	    my $info = Tags::get_tag_info($t);

	    fail("unknown tag specified: $t") unless defined($info);
	    my $script = $info->{'script'};
	    next if $script eq 'maemian';
	    if ($check_info{$script}) {
		$checks{$script} = 1;
	    } else {
		# should never happen
		fail("no info for script $script");
	    }
	}
    } else {
	my %dont_check = map { $_ => 1 } (split m/,/, ($dont_check || ""));
	$checks or ($checks = join(',',keys %check_info));
	for my $c (split(/,/,$checks)) {
	    if ($check_info{$c}) {
		if ($dont_check{$c}
		    || ($check_info{$c}->{'abbrev'}
			&& $dont_check{$check_info{$c}->{'abbrev'}})) {
		    #user requested not to run this check
		} elsif ($check_info{$c}->{'requested-tags'} == 0) {
		    #no need to run this check, no tags will be issued
		} else {
		    $checks{$c} = 1;
		}
	    } elsif (exists $check_abbrev{$c}) {
		#abbrevs only used when -C is given, so we don't need %dont_check
		$checks{$check_abbrev{$c}} = 1;
	    } else {
		fail("unknown check specified: $c");
	    }
	}
    }

    # determine which info is needed by the checks
    for my $c (keys %checks) {
	for my $i (keys %collection_info) {
	    # required by $c ?
	    if ($check_info{$c}->{$i}) {
		$unpack_infos{$i} = 1;
	    }
	}
    }
}

# }}}

# {{{ determine which info is needed by the collection scripts
for my $c (keys %unpack_infos) {
    for my $i (keys %collection_info) {
	# required by $c ?
	if ($collection_info{$c}->{$i}) {
	    $unpack_infos{$i} = 1;
	}
    }
}
# }}}

# {{{ process all packages in the archive?
if ($check_everything) {
    # make sure package info is available
    read_src_list("$MAEMIAN_LAB/info/source-packages", 0);
    read_bin_list("$MAEMIAN_LAB/info/binary-packages", 0);
    read_udeb_list("$MAEMIAN_LAB/info/udeb-packages", 0);

    debug_msg(2, "pkg_mode = $pkg_mode");

    if (($pkg_mode eq 'a') or ($pkg_mode eq 's')) {
	for my $arg (sort keys %source_info) {
	    debug_msg(1, "doing stuff with $MAEMIAN_ARCHIVEDIR/$source_info{$arg}->{'file'}");
	    $schedule->add_file('s', "$MAEMIAN_ARCHIVEDIR/$source_info{$arg}->{'file'}",
				%{$source_info{$arg}});
	}
    }
    if (($pkg_mode eq 'a') or ($pkg_mode eq 'b')) {
	for my $arg (sort keys %binary_info) {
	    debug_msg(1, "doing stuff with $MAEMIAN_ARCHIVEDIR/$binary_info{$arg}->{'file'}");
	    $schedule->add_file('b', "$MAEMIAN_ARCHIVEDIR/$binary_info{$arg}->{'file'}",
				%{$binary_info{$arg}});
	}
    }
    if (($pkg_mode eq 'a') or ($pkg_mode eq 'u')) {
	for my $arg (sort keys %udeb_info) {
	    debug_msg(1, "doing stuff with $MAEMIAN_ARCHIVEDIR/$udeb_info{$arg}->{'file'}");
	    $schedule->add_file('u', "$MAEMIAN_ARCHIVEDIR/$udeb_info{$arg}->{'file'}",
				%{$udeb_info{$arg}});
	}
    }

    # package list still empty?
    unless ($schedule->count) {
	warning("no packages found in distribution directory");
    }
} elsif ($packages_file) {	# process all packages listed in packages file?
    $schedule->add_pkg_list($packages_file);
}
# }}}

# {{{ Some silent exit
unless ($schedule->count) {
    v_msg("No packages selected.");
    exit 0;
}
# }}}

# {{{ Okay, now really processing the packages in one huge loop
$unpack_infos{ "override-file" } = 1 unless $no_override;
v_msg(sprintf("Processing %d packages...", $schedule->count));
debug_msg(1,
	  "Selected action: $action",
	  "Requested unpack level: $unpack_level",
	  sprintf("Requested data to collect: %s", join(',',keys %unpack_infos)),
	  sprintf("Selected checks: %s", join(',',keys %checks)),
    );

require Checker;
require Maemian::Collect;

my %overrides;
my @pending_jobs;
PACKAGE:
foreach my $pkg_info ($schedule->get_all) {
    my ($type, $pkg, $ver, $arch, $file) =
	@$pkg_info{qw(type package version architecture file)};
    my $long_type = ($type eq 'b' ? 'binary' :
		     ($type eq 's' ? 'source' : 'udeb' ));

    Tags::set_pkg( $file, $pkg, $ver, $arch, $long_type );

    # Kill pending jobs, if any
    Maemian::Command::kill(@pending_jobs);
    undef @pending_jobs;

    # determine base directory
    my $base = "$MAEMIAN_LAB/$long_type/$pkg";
    unless ($base =~ m,^/,) {
	$base = "$cwd/$base";
    }
    debug_msg(1, "Base directory in lab: $base");

    my $act_unpack_level = 0;

    # unpacked package up-to-date?
    if (-d $base) {
	my $remove_basedir = 0;

        # there's a base dir, so we assume that at least
        # one level of unpacking has been done
	$act_unpack_level = 1;

	# maemian status file exists?
	unless (-f "$base/.maemian-status") {
	    v_msg("No maemian status file found (removing old directory in lab)");
	    $remove_basedir = 1;
	    goto REMOVE_BASEDIR;
	}

	# read unpack status -- catch any possible errors
	my $data;
	eval { ($data) = read_dpkg_control("$base/.maemian-status"); };
	if ($@) {		# error!
	    v_msg($@);
	    $remove_basedir = 1;
	    goto REMOVE_BASEDIR;
	}

	# compatible maemian version?
	if (not exists $data->{'lab-format'} or ($data->{'lab-format'} < $LAB_FORMAT)) {
	    v_msg("Lab directory was created by incompatible maemian version");
	    $remove_basedir = 1;
	    goto REMOVE_BASEDIR;
	}

	# version up to date?
	if (not exists $data->{'version'} or ($data->{'version'} ne $ver)) {
	    debug_msg(1, "Removing package in lab (newer version exists) ...");
	    $remove_basedir = 1;
	    goto REMOVE_BASEDIR;
	}

	# unpack level defined?
	unless (exists $data->{'unpack-level'}) {
	    warning("cannot determine unpack-level of package");
	    $remove_basedir = 1;
	    goto REMOVE_BASEDIR;
        } else {
            $act_unpack_level = $data->{'unpack-level'};
	}

	# file modified?
	my $timestamp;
	my @stat;
	unless (@stat = stat $file) {
	    warning("cannot stat file $file: $!");
	} else {
	    $timestamp = $stat[9];
	}
	if ((not defined $timestamp) or (not exists $data->{'timestamp'}) or ($data->{'timestamp'} != $timestamp)) {
	    debug_msg(1, "Removing package in lab (package has been changed) ...");
	    $remove_basedir = 1;
	    goto REMOVE_BASEDIR;
	}

    REMOVE_BASEDIR:
	if ($remove_basedir) {
	    v_msg("Removing $pkg");
	    unless (remove_pkg($base)) {
		warning("skipping $action of $long_type package $pkg");
		$exit_code = 2;
		next PACKAGE;
	    }
	    $act_unpack_level = 0;
	}
    }

    # unpack to requested unpack level
    $act_unpack_level = unpack_pkg($type,$base,$file,$act_unpack_level,
				   $unpack_level);
    if ($act_unpack_level == -1) {
	warning("could not unpack package to desired level",
		"skipping $action of $long_type package $pkg");
	$exit_code = 2;
	next PACKAGE;
    }

    if (($action eq 'unpack') or ($action eq 'check')) { # collect info
	my $current_order = -1;
	for my $coll (sort by_collection_order keys %unpack_infos) {
	    my $ci = $collection_info{$coll};
	    my %run_opts = ('description' => $coll);

	    # current type?
	    next unless ($ci->{'type'} =~ m/$type/);

	    # If a file named .SCRIPT-VERSION already exists, we've already
	    # collected this information and we can skip it.  Otherwise,
	    # remove any .SCRIPT-* files (which are old version information).
	    next if (-f "$base/.${coll}-$ci->{'version'}");
	    opendir(BASE, $base)
		or fail("cannot read directory $base: $!");
	    for my $file (readdir BASE) {
		if ($file =~ /^\.\Q$coll-/) {
		    unlink("$base/$file");
		}
	    }
	    closedir(BASE);

	    # unpack to desired unpack level (if necessary)
	    $act_unpack_level = unpack_pkg($type,$base,$file,$act_unpack_level,$ci->{'unpack-level'});
	    if ($act_unpack_level == -1) {
		warning("could not unpack package to desired level",
			"skipping $action of $long_type package $pkg");
		$exit_code = 2;
		next PACKAGE;
	    }

	    # chdir to base directory
	    unless (chdir($base)) {
		warning("could not chdir into directory $base: $!",
			"skipping $action of $long_type package $pkg");
		$exit_code = 2;
		next PACKAGE;
	    }

	    $current_order = $ci->{'order'} if ($current_order == -1);
	    if ($current_order != $ci->{'order'}) {
		debug_msg(1, "Waiting for jobs from order $current_order ...");
		unless (reap_collect_jobs($pkg, $base, @pending_jobs)) {
		    warning("skipping $action of $long_type package $pkg");
		    $exit_code = 2;
		    next PACKAGE;
		}
		undef @pending_jobs;
		$current_order = $ci->{'order'};
	    }

	    # collect info
	    remove_status_file($base);
	    debug_msg(1, "Collecting info: $coll ...");
	    my $script = "$MAEMIAN_ROOT/collection/$ci->{'script'}";
	    unless (spawn(\%run_opts, [ $script, $pkg, $long_type, '&' ])) {
		warning("collect info $coll about package $pkg failed",
			"skipping $action of $long_type package $pkg");
		$exit_code = 2;
		next PACKAGE;
	    }
	    push @pending_jobs, \%run_opts;
	}

	# wait until all the jobs finish and skip this package if any of them
	# failed.
	debug_msg(1, "Waiting for jobs from order $current_order ...");
	unless (reap_collect_jobs($pkg, $base, @pending_jobs)) {
	    warning("skipping $action of $long_type package $pkg");
	    $exit_code = 2;
	    next PACKAGE;
	}
	undef @pending_jobs;
    }

    if ($action eq 'check') { 	# read override file

	unless ($no_override) {
	    Tags::add_overrides("$base/override", $pkg, $long_type)
		if (-f "$base/override")
        }

	# perform checks
	my $info = Maemian::Collect->new($pkg, $long_type);
	for my $check (keys %checks) {
	    my $ci = $check_info{$check};

	    # current type?
	    next unless ($ci->{'type'} =~ m/$type/);

	    # unpack to desired unpack level (if necessary)
	    $act_unpack_level = unpack_pkg($type,$base,$file,$act_unpack_level,$ci->{'unpack-level'});
	    if ($act_unpack_level == -1) {
		warning("could not unpack package to desired level",
			"skipping $action of $long_type package $pkg");
		$exit_code = 2;
		next PACKAGE;
	    }

	    # chdir to base directory
	    unless (chdir($base)) {
		warning("could not chdir into directory $base: $!",
			"skipping $action of $long_type package $pkg");
		$exit_code = 2;
		next PACKAGE;
	    }

	    my $returnvalue = Checker::runcheck($pkg, $long_type, $info, $check);
	    # Set exit_code correctly if there was not yet an exit code
	    $exit_code = $returnvalue unless $exit_code;

	    if ($returnvalue == 2) {
		warning("skipping $action of $long_type package $pkg");
		next PACKAGE;
	    }

	}
	unless ($exit_code) {
	    my $stats = Tags::get_stats( $file );
	    if ($stats->{types}{E}) {
		$exit_code = 1;
	    } elsif ($fail_on_warnings && $stats->{types}{W}) {
		$exit_code = 1;
	    }
	}

	# report unused overrides
	if (not $no_override) {
	    my $overrides = Tags::get_overrides( $file );

	    for my $tag (sort keys %$overrides) {
		my $taginfo = Tags::get_tag_info{$tag};
		if (defined $taginfo) {
		    # Did we run the check script containing the tag?
		    next unless $checks{$taginfo->{'script'}};

		    # If only checking specific tags, is this one of them?
		    next unless (scalar keys %Tags::only_issue_tags == 0)
			or exists $Tags::only_issue_tags{$tag};
		}

		for my $extra (sort keys %{$overrides->{$tag}}) {
		    next if $overrides->{$tag}{$extra};

		    tag( "unused-override", $tag, $extra );
		}
	    }
	}

	# Report override statistics.
	if (not $no_override and not $show_overrides) {
	    my $stats = Tags::get_stats($file);
	    my $short = $file;
	    $short =~ s%.*/%%;
	    my $errors = $stats->{overrides}{types}{E} || 0;
	    my $warnings = $stats->{overrides}{types}{W} || 0;
	    my $info = $stats->{overrides}{types}{I} || 0;
	    $overrides{errors} += $errors;
	    $overrides{warnings} += $warnings;
	    $overrides{info} += $info;
        }
    }

    # chdir to maemian root directory (to unlock $base so it can be removed below)
    unless (chdir($MAEMIAN_ROOT)) {
	warning("could not chdir into directory $MAEMIAN_ROOT: $!",
		"skipping $action of $long_type package $pkg");
	$exit_code = 2;
	next PACKAGE;
    }

    # clean up
    if ($act_unpack_level > $unpack_level) {
	$act_unpack_level = clean_pkg($type,$base,$file,$act_unpack_level,$unpack_level);
	if ($act_unpack_level == -1) {
	    warning("could not clean up laboratory for package $pkg: $!",
		    "skipping clean up");
	    $exit_code = 2;
	    next PACKAGE;
	}
    }

    # create Maemian status file
    if (($act_unpack_level > 0) and (not -f "$base/.maemian-status")) {
	my @stat;
	unless (@stat = stat $file) {
	    warning("cannot stat file $file: $!",
		    "skipping creation of status file");
	    $exit_code = 2;
	    next PACKAGE;
	}
	my $timestamp = $stat[9];

	unless (open(STATUS, '>', "$base/.maemian-status")) {
	    warning("could not create status file $base/.maemian-status for package $pkg: $!");
	    $exit_code = 2;
	    next PACKAGE;
	}

	print STATUS "Maemian-Version: $MAEMIAN_VERSION\n";
	print STATUS "Lab-Format: $LAB_FORMAT\n";
	print STATUS "Package: $pkg\n";
	print STATUS "Version: $ver\n";
	print STATUS "Type: $type\n";
	print STATUS "Unpack-Level: $act_unpack_level\n";
	print STATUS "Timestamp: $timestamp\n";
	close(STATUS);
    }
}
Tags::reset_pkg();
if ($action eq 'check' and not $no_override and not $show_overrides) {
    my $errors = $overrides{errors} || 0;
    my $warnings = $overrides{warnings} || 0;
    my $info = $overrides{info} || 0;
    my $total = $errors + $warnings + $info;
    if ($total > 0) {
	my $total = ($total == 1)
	    ? "$total tag overridden"
	    : "$total tags overridden";
	my @output;
	if ($errors) {
	    push (@output, ($errors == 1) ? "$errors error" : "$errors errors");
	}
	if ($warnings) {
	    push (@output, ($warnings == 1) ? "$warnings warning" : "$warnings warnings");
	}
	if ($info) {
	    push (@output, "$info info");
	}
	msg("$total (". join (', ', @output). ")");
    }
}

# }}}

exit $exit_code;

# {{{ Some subroutines

sub unpack_pkg {
    my ($type,$base,$file,$cur_level,$new_level) = @_;

    debug_msg(1, sprintf("Current unpack level is %d",$cur_level));

    return $cur_level if $cur_level == $new_level;

    # remove .maemian-status file
    remove_status_file($base);

    if ( ($cur_level == 0) and (-d $base) ) {
       # We were lied to, there's something already there - clean it up first
       remove_pkg($base) or return -1;
    }

    if ( ($new_level >= 1) and
	 (not defined ($cur_level) or ($cur_level < 1)) ) {
	# create new directory
	debug_msg(1, "Unpacking package to level 1 ...");
	if (($type eq 'b') || ($type eq 'u')) {
	    spawn({}, ["$MAEMIAN_ROOT/unpack/unpack-binpkg-l1", $base, $file])
		or return -1;
	} else {
	    spawn({}, ["$MAEMIAN_ROOT/unpack/unpack-srcpkg-l1", $base, $file])
		or return -1;
	}
	$cur_level = 1;
    }

    if ( ($new_level >= 2) and
	 (not defined ($cur_level) or ($cur_level < 2)) ) {
	# unpack package contents
	debug_msg(1, "Unpacking package to level 2 ...");
	if (($type eq 'b') || ($type eq 'u')) {
	    spawn({}, ["$MAEMIAN_ROOT/unpack/unpack-binpkg-l2", $base])
		or return -1;
	} else {
	    debug_msg(1, "$MAEMIAN_ROOT/unpack/unpack-srcpkg-l2 $base");
	    spawn({}, ["$MAEMIAN_ROOT/unpack/unpack-srcpkg-l2", $base])
		or return -1;
	}
	$cur_level = 2;
    }

    return $cur_level;
}

# Given a list of jobs corresponding to collect scripts, reap each of the
# jobs.  For each successful job, record that it was successful by creating
# the corresponding version marker file in the lab.  For each unsuccessful
# job, warn that it was unsuccessful.
#
# Takes the current package, base directory, and the list of pending jobs.
# Return true if all jobs were successful, false otherwise.
sub reap_collect_jobs {
    my ($pkg, $base, @pending_jobs) = @_;
    my $status = reap(@pending_jobs);
    for my $job (@pending_jobs) {
	my $coll = $job->{'description'};
	if ($job->{success}) {
	    my $ci = $collection_info{$coll};
	    open(VERSION, '>', "$base/.${coll}-$ci->{'version'}")
		or fail("cannot create $base/.${coll}-$ci->{'version'}: $!");
	    print VERSION "Maemian-Version: $MAEMIAN_VERSION\n"
		. "Timestamp: " . time . "\n";
	    close(VERSION);
	} else {
	    warning("collect info $coll about package $pkg failed");
	}
    }
    return $status;
}

# TODO: is this the best way to clean dirs in perl?
# no, look at File::Path module
sub clean_pkg {
    my ($type,$base,$file,$cur_level,$new_level) = @_;

    return $cur_level if $cur_level == $new_level;

    if ($new_level < 1) {
	# remove base directory
	remove_pkg($base) or return -1;
	return 0;
    }

    if ( ($new_level < 2) and defined ($cur_level) and ($cur_level >= 2) ) {
	# remove .maemian-status file
	remove_status_file($base);

	# remove unpacked/ directory
	debug_msg(1, "Decreasing unpack level to 1 (removing files) ...");
	if ( -l "$base/unpacked" ) {
	    delete_dir("$base/".readlink("$base/unpacked"))
		or return -1;
	    delete_dir("$base/unpacked") or return -1;
	} else {
	    delete_dir("$base/unpacked") or return -1;
	}

	$cur_level = 1;
    }

    return $cur_level;
}

# this function removes a package's base directory in the lab completely
sub remove_pkg {
    my ($base) = @_;

    debug_msg(1, "Removing package in lab ...");
    unless (delete_dir($base)) {
	warning("cannot remove directory $base: $!");
	return 0;
    }

    return 1;
}

sub remove_status_file {
    my ($base) = @_;

    # status file exists?
    if (not -e "$base/.maemian-status") {
	return 1;
    }

    if (not unlink("$base/.maemian-status")) {
	warning("cannot remove status file $base/.maemian-status: $!");
	return 0;
    }

    return 1;
}

# get package name, version, and file name from the lab
sub get_bin_info_from_lab {
    my ($base_dir) = @_;
    my ($pkg,$ver,$arch,$file);

    ($pkg = read_file("$base_dir/fields/package"))
	or fail("cannot read file $base_dir/fields/package: $!");

    ($ver = read_file("$base_dir/fields/version"))
	or fail("cannot read file $base_dir/fields/version: $!");

    ($arch = read_file("$base_dir/fields/architecture"))
	or fail("cannot read file $base_dir/fields/architecture: $!");

    ($file = readlink("$base_dir/deb"))
	or fail("cannot read link $base_dir/deb: $!");

    return ($file, package => $pkg, version => $ver, architecture => $arch);
}

# get package name, version, and file name from the lab
sub get_src_info_from_lab {
    my ($base_dir) = @_;
    my ($pkg,$ver,$file);

    ($pkg = read_file("$base_dir/fields/source"))
	or fail("cannot read file $base_dir/fields/source: $!");

    ($ver = read_file("$base_dir/fields/version"))
	or fail("cannot read file $base_dir/fields/version: $!");

    ($file = readlink("$base_dir/dsc"))
	or fail("cannot read link $base_dir/dsc: $!");

    return ($file, source => $pkg, version => $ver);
}

# read first line of a file
sub read_file {
    my $first_line;

    open(T, '<', $_[0]) or return;
    chop($first_line = <T>);
    close(T) or return;

    return $first_line;
}

# sort collection list by `order'
sub by_collection_order {
    $collection_info{$a}->{'order'} <=> $collection_info{$b}->{'order'};
}

sub END {
    # Prevent Lab::delete from affecting the exit code.
    local $?;

    $SIG{'INT'} = 'DEFAULT';
    $SIG{'QUIT'} = 'DEFAULT';

    $LAB->delete() if $LAB and not $keep_lab;
}

sub interrupted {
    $SIG{$_[0]} = 'DEFAULT';
    die "N: Interrupted.\n";
}

1;
__END__