#!/usr/bin/perl
#
#	This program reads a config file, traverse through all .changes files
#	in the specified directory and puts the files into the right place.
#
#    Copyright (C) 2000-2008 Ola Lundqvist <ola@inguza.com>
#    Copyright (C) 2007      Turbo Fredriksson <turbo@bayour.com>
#    Copyright (C) 2004-2005 Russ Allbery <rra@stanford.edu>
#    Copyright (C) 2005      Joel Baker <lucifer@lightbearer.com>
#    Copyright (C) 2005      Daniel Leidert <daniel.leidert@wgdd.de>
#    Copyright (C) 2005      Bob Proulx <bob@proulx.com>
#    Copyright (C) 2005-2006 Valry Perrin <valery.perrin@free.fr>
#    Copyright (C) 2006      Yaroslav Halchenko <debian@onerussian.com>
#    Copyright (C) 2006      Jrmy Bobbio <jeremy.bobbio@etu.upmc.fr>
#    Copyright (C) 2006      Michael Hanke <michael.hanke@gmail.com>
#    Copyright (C) 2006      Martin F Krafft <madduck@debian.org>
#    Copyright (C) 2006      Hkon Stordahl <haastord@online.no>
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
#    MA 02110-1301, USA.
#
###############################################################################
############################# USES ############################################
###############################################################################

use Digest::MD5;
use File::Path qw(mkpath);
use OpaL::action qw(pdebug action cmdaction
		    setDebugLevel
		    setQuitLevel
		    setErrorHandler);
use OpaL::read qw(readfile readcommand);

###############################################################################
########################### CONSTANTS #########################################
###############################################################################
# Changelog:
#  2000-2004 Ola Lundqvist <ola@inguza.com>
#	Written
#  2005-05-01 Ola Lundqvist <ola@inguza.com>
#	Bug fix for bzip2 support.
#  2005-05-06 Daniel Leidert <daniel.leidert@wgdd.de>
#       Add setting to enable/disable signature checking in distinput-dirs.
#  2005-09-09 Ola Lundqvist <ola@inguza.com>
#       Support for gpg password file.
#  2005-09-15 Daniel Leidert <daniel.leidert.spam@gmx.net>
#       Fix regarding $gpgpassfile.
#  2005-10-08 Ola Lundqvist <ola@inguza.com>
#	Now invokes a helper program to sign the files. It may be implemented
#	by some perl module but this solution was good enough.
#  2005-10-11 Daniel Leidert <daniel.leidert@wgdd.de>
#	Removed fix regarding $gpgpassfile (moved to checks below).
#  2005-10-12 Daniel Leidert <daniel.leidert@wgdd.de>
#	Fix signcmd default.
#  2005-10-14 Daniel Leidert <daniel.leidert@wgdd.de>
#	Remove signcmd variable.
#  2007-10-09 Turbo Fredriksson <turbo@bayour.com>
#       Allow forcing an install of an upload (i.e., ignore existing files in
#       destdir).
#  2007-10-09 Ola Lundqvist <ola@inguza.com>
#       Changed force option to ignoredestcheck option.

$copycmd = "cp -af";
$rmcmd = "rm -f";
$mailcmd = "mail";
$movecmd = "mv";
$vrfycmd = "dscverify";
$cachedir = "/var/cache/debarchiver";
$inputdir = "/var/lib/debarchiver/incoming";
$destdir = "/var/lib/debarchiver/dists";
$cinstall = "installed";
$lockfile = "debarchiver.lock";
$etcconfigfile = "/etc/debarchiver.conf";
$inputconfigfile = "input.conf";
$verifysignatures = 0;
$verifysignaturesdistinput = 0;
$userconfigfile = "$ENV{HOME}/.debarchiver.conf";
$bzip = 0;
$gpgpassfile = "$ENV{HOME}/.gnupg/passphrase";

###############################################################################
########################## DECLARATION ########################################
###############################################################################
# Changelog:
#  2000-2004 Ola Lundqvist <ola@inguza.com>
#	Written
#  2007-10-08 Ola Lundqvist <ola@inguza.com>
#       Updated with new options.
#  2007-10-09 Ola Lundqvist <ola@inguza.com>
#       Changed force option to ignoredestcheck option.

# Indexed by config name.
%CConf = ();
# Indexed by meta type.
%CMeta = ();
# Indexed by file name.
%CFiles = ();
# Indexed by package name.
%CDesc = ();
# Just a string describing what has changed.
$CChanges = "";
# Destination directories that should be scanned.
%dests = ();
# Information to add to Release files.
%release = ();
# The criteria to use for which binary packages that does not need a .changes
# file.
$distinputcriteria = "^linux.*\\.deb\$";
# Extra directories with specified destination. Where to find for distinput
# files.
%distinputdirs = (
		  stable => 'stable',
		  testing => 'testing',
		  unstable => 'unstable'
		  );

@distributions = ('stable', 'testing', 'unstable');

%distmapping = (
		stable => 'lenny',
		testing => 'squeeze',
		unstable => 'sid'
		);

@architectures = ('i386');

@sections = ('main', 'contrib', 'non-free');

# Default major
$majordefault = 'main';

@mailtos = ();

$mailfrom = "";

@ARGS1 = @ARGV;
@ARGS2 = ();

$incompletetime = 24*60*60;
$sortpackages = 1;
$fixstructure = 1;
$ignoredestcheck = 0;

###############################################################################
############################# ARGS ############################################
###############################################################################
# Changelog:
#  2000-2004 Ola Lundqvist <ola@inguza.com>
#	Written
#  2005-10-08 Ola Lundqvist <ola@inguza.com>
#	Added the possibility to specify a config file on command line.
#	Inspired by a patch from Alexander Wirt <formorer@debian.org>.

while ($_ = shift @ARGS1) {
    if (/^-[a-zA-Z0-9]/) {
	if (length($_) > 1) {
	    s/^-//;
	    foreach $_ (split /(.)/, $_) {
		if (length($_) > 0) {
		    @ARGS1 = ("-$_", @ARGS1);
		}
	    }
	    $_ = shift @ARGS1;
	}
	else {
	    pdebug(2, "Unknown option $_.");
	}
    }
    if (/^-/) {
	if (/^--dl$/ || /^--debug-level$/) {
	    setDebugLevel(shift @ARGS1);
	}
	elsif (/^--ql$/ || /^--quit-level$/) {
	    setQuitLevel(shift @ARGS1);
	}
	elsif (/^--configfile$/) {
	    $cmdlineconfigfile = shift @ARGS1;
	}
	elsif (/^-i$/ || /^--input$/ || /^--indir$/ || /^--inputdir$/) {
	    $inputdir = shift @ARGS1;
	    $inputdir =~ s/\/$//;
	}
	else {
	    push @ARGS2, $_;
	}
    }
    else {
	push @ARGS2, $_;
    }
}

###############################################################################
############################ CONFIG ###########################################
###############################################################################
# Changelog:
#  2000-2004 Ola Lundqvist <ola@inguza.com>
#	Written
#  2005-10-08 Ola Lundqvist <ola@inguza.com>
#	Added the possibility to specify a config file on command line.
#	Inspired by a patch from Alexander Wirt <formorer@debian.org>.
#  2007-08-14 Ola Lundqvist <ola@inguza.com>
#       Changed severity level for configuration file problems from info
#       to warning, so that it is displayed in the normal case.

if (-e $etcconfigfile) {
    my $t = do $etcconfigfile;
    unless ($t) {
	pdebug(3, "Loading config file $etcconfigfile:\n\t$!\n\t$@");
    }
}

if (-e $userconfigfile) {
    my $t = do $userconfigfile;
    unless ($t) {
	pdebug(3, "Loading config file $userconfigfile:\n\t$!\n\t$@");
    }
}

if (-e $cmdlineconfigfile) {
    my $t = do $cmdlineconfigfile;
    unless ($t) {
	pdebug(3, "Loading config file $cmdlineconfigfile:\n\t$!\n\t$@");
    }
}

###############################################################################
######################### INPUT CONFIG ########################################
###############################################################################
# Changelog:
#  2000-2004 Ola Lundqvist <ola@inguza.com>
#	Written
#  2007-08-14 Ola Lundqvist <ola@inguza.com>
#       Changed severity level for configuration file problems from info
#       to warning, so that it is displayed in the normal case.

action(! chdir $inputdir, "Change to dir $inputdir", 2);

if (-e $inputconfigfile) {
    my $t = do $inputconfigfile;
    unless ($t) {
	pdebug(3, "Loading config file $inputconfigfile:\n\t$!\n\t$@");
    }
}

###############################################################################
############################# CHECKS ##########################################
###############################################################################
# Changelog:
#  2005-10-11 Daniel Leidert <daniel.leidert@wgdd.de>
#	Written

if ($gpgpassfile) {
	$gpgpassfile = "" if (! -f $gpgpassfile);
}
else {
	$gpgpassfile = "";
}
				

###############################################################################
############################# HELP ############################################
###############################################################################
# Changelog:
#  2000-2004 Ola Lundqvist <ola@inguza.com>
#	Written
#  2005-09-09 Ola Lundqvist <ola@inguza.com>
#       Added information about gpg support.
#  2005-10-08 Ola Lundqvist <ola@inguza.com>
#	Added the possibility to specify a config file on command line.
#	Inspired by a patch from Alexander Wirt <formorer@debian.org>.
#	Now invokes a helper program to sign the files. It may be implemented
#	by some perl module but this solution was good enough.
#  2005-10-14 Daniel Leidert <daniel.leidert@wgdd.de>
#	Removed signcmd.
#  2006-02-25 Yaroslav Halchenko <debian@onerussian.com> and
#             Ola Lundqvist <ola@inguza.com>
#       Default major section function.
#  2006-11-28 Ola Lundqvist <ola@inguza.com>
#       Sorted options in alphabetical order.
#  2007-10-08 Ola Lundqvist <ola@inguza.com>
#       Make it possible to specify mail sender.
#  2007-10-09 Turbo Fredriksson <turbo@bayour.com>
#       Allow forcing an install of an upload (i.e., ignore existing files in
#       destdir).
#  2007-10-09 Ola Lundqvist <ola@inguza.com>
#       Changed force option to ignoredestcheck option.

$version = "0.8.0";
$versionstring = "Debian package archiver, version $version";

$help =
    "Usage: debarchiver [option(s)]

options:
 -a | --autoscan       	Does both --autoscanpackages and --autoscansources.
                         Use this *or* --index, not both.
 --autoscanall		Same as --scanall --autoscan.
 --autoscanpackages	Automaticly run dpkg-scanpackages after all new
			 packages are installed.
 --autoscansources	Automaticly run dpkg-scansources after all new
			 packages are installed.
 -b | --bzip            Create bzip2 compressed Packages.bz2 and Sources.bz2
			 files. 
 --cachedir dir         The apt-ftparchive package cache directory, if --index
                         is used.  Default $cachedir.
 --cinstall dir		Where the .changes file will be installed to,
			 empty string to remove it instead, default $cinstall.
 --configfile file      Specify an extra configuration file to read. Will be read
                         after etc config and user config file.
 --copycmd		The install command to use, default $copycmd.
			 Both packages and .changes files are installed using
			 this command.
 -d | --dest dir       	Destination directory. The base directory where all
  --destdir dir		 the distribution packages reside. Here the
			 \$distrib/\$major/\$arch/\$section directory structure
			 will be created.
                         Default $destdir,
                         relative to the input directory.
 --debug-level level	What information that should be printed.
  --dl level		 1 = critical, 2 = error, 3 = normal,
			 4 = message, 5 = debug, 6 = verbose debug (modules).
 --distinputcriteria     The criteria for which binary packages that should be
			 installed even if it does not have a .changes file,
			 default $distinputcriteria.
 --gpgkey               GnuPG key to use to sign the archive.
 --gpgpassfile          File to provide password to GnuPG.
 --help			Prints this information.
 -i | --input dir      	This is the directory where debarchiver is looking for
  --indir dir		 new packages corresponding *.changes files that
  --inputdir dir	 should be installed to the --dest directory.
			 The default directory is
			 /var/lib/debarchiver/incoming.
 --index | -x           Automatically run apt-ftparchive after all new packages
                         are installed.  Use this *or* --autoscan, not both.
 --instcmd		DEPRICATED!
 --lockfile file	The lockfile to use, default $lockfile.
 --incompletetime       The time to allow .changes file to be incomplete in
                         seconds. Defaults to 24 hours.
 --mailcmd		The mail command to use, default $mail.
 --mailfrom             Specify mail sender.
 --majordefault section Default major section to use if undefined
                        (default: main)
 --movecmd		Command to move files (currently not used at all).
 --nosort		Do not sort packages.
 --nostructurefix	Do not create directories and touch Package files.
 -o | --addoverride    	Automaticly add new packages to the override file.
 --rmcmd		The remove command to use, default $rmcmd.
			 This can be used to move away the old packages to
			 some other place.
 --quit-level level	On what level to quit the application, see debug level.
 --scanall		Scan all distributions, sections, etc.
 --scandetect | -s      Scan using apt-ftparchive or dpkg-scan* depending on
                         what is installed on the system. This is the
                         recommended way. Only use --index or --autoscan if
                         you know what you are doing.
 --scanonly             Same as --nosort --nostructurefix.
 -v | --version		Prints the version string.
 --ignoredestcheck	Force install of changes files even if some files
                        already exists with wrong size or md5 hash.

You can also place config files with the following names (in following order)
$etcconfigfile, $userconfigfile and $inputconfigfile
(relative to input dir), that will be read before the arguments to this program
will be parsed. Here you can change the following variables
        \$cachedir	The cache directory for apt-ftparchive, used if
			--index is used.
	\$cinstall	Where the .changes files are installed
			 (see --cinstall above).
	\$copycmd	The install command (see --copycmd).
	\$destdir      	The destination directory (see --destdir above).
        \$distinputcriteria The criteria for which packages that should be
			 installed even if it does not have a .changes file,
			 default $distinputcriteria.
        \%distinputdirs The directories (distribution => dir) that should be
			 searched for extra binary packages that does not need
			 a .changes file to be installed.
	\$gpgkey	GnuPG key to use to sign the archive.
        \$gpgpassfile   File to provide password to GnuPG.
	\$inputdir	The input directory (no effect in $inputconfigfile).
	\$lockfile	The lockfile to use, default $lockfile.
        \$ignoredestcheck Force install of changes files even if some files
                         already exists with wrong size or md5 hash.
                         Default to 0.
        \$incompletetime The time to allow .changes file to be incomplete in
                         seconds. Defaults to 24 hours.
	\@mailtos	The fields in .changes file that should be used for
			 mailing SUCCESS and REJECT messages. If there is an
			 @ char in the arrach it will be used directly.
        \$mailfrom      Specify mail sender.
	\$majordefault  Default major section (see --majordefault above).
	\$movecmd	The move command (see --movecmd).
        \%release	Additional information to add to generated Release
			 files.  Supported keys are origin, label, and
			 description.
	\$rmcmd		The remove command (see --rmcmd above).
";

###############################################################################
############################# ARGS ############################################
###############################################################################
# Changelog:
#  2000-2004 Ola Lundqvist <ola@inguza.com>
#	Written
#  2005-05-01 Daniel Leidert <daniel.leidert.spam@gmx.net>
#	Added bzip2 support.
#  2005-09-09 Ola Lundqvist <ola@inguza.com>
#       Added options for gpg signing support.
#  2006-02-25 Yaroslav Halchenko <debian@onerussian.com> and
#             Ola Lundqvist <ola@inguza.com>
#       Default major section function.
#  2007-10-09 Turbo Fredriksson <turbo@bayour.com>
#       Allow forcing an install of an upload (i.e., ignore existing files in
#       destdir).
#  2007-10-09 Ola Lundqvist <ola@inguza.com>
#       Changed force option to ignoredestcheck option.

while ($_ = shift @ARGS2) {
    if (/^-[a-zA-Z0-9]/) {
	if (length($_) > 1) {
	    s/^-//;
	    foreach $_ (split /(.)/, $_) {
		if (length($_) > 0) {
		    @ARGS1 = ("-$_", @ARGS1);
		}
	    }
	    $_ = shift @ARGS1;
	}
	else {
	    pdebug(2, "Unknown option $_.");
	}
    }
    if (/^-/) {
	if (/^-v$/ || /^--version$/) {
	    print("$versionstring\n");
	    exit(0);
	}
	elsif (/^--help$/) {
	    print($help);
	    exit(0);
	}
	elsif (/^--copycmd$/) {
	    $copycmd = shift @ARGS2;
	}
	elsif (/^--movecmd$/) {
	    $movecmd = shift @ARGS2;
	}
	elsif (/^--mailcmd$/) {
	    $mailcmd = shift @ARGS2;
	}
	elsif (/^--mailfrom$/) {
	    $mailfrom = shift @ARGS2;
	}
	elsif (/^--incompletetime$/) {
	    $incompletetime = shift @ARGS2;
	}
	elsif (/^--rmcmd$/) {
	    $rmcmd = shift @ARGS2;
	}
	elsif (/^-d$/ || /^--destdir$/ || /^--dest$/) {
	    $destdir = shift @ARGS2;
	    $destdir =~ s/\/$//;
	}
	elsif (/^--majordefault$/) {
	    $majordefault = shift @ARGS2;
	    $majordefault =~ s/\/$//;
	}
	elsif (/^--cachedir$/) {
	    $cachedir = shift @ARGS2;
	}
	elsif (/^--lockfile$/) {
	    $lockfile = shift @ARGS2;
	}
	elsif (/^--cinstall$/) {
	    $cinstall = shift @ARGS2;
	    $cinstall =~ s/\/$//;
	}
	elsif (/^-o$/ || /^--addoverride$/) {
	    $addoverride = 1;
	}
	elsif (/^--gpgkey$/) {
	    $gpgkey = shift @ARGS2;
	}
	elsif (/^--gpgpassfile$/) {
	    $gpgpassfile = shift @ARGS2;
	}
	elsif (/^--autoscanpackages$/) {
	    $autoscanpackages = 1;
	}
	elsif (/^--autoscansources$/) {
	    $autoscansources = 1;
	}
	elsif (/^-a$/ || /^--autoscan$/) {
	    $autoscanpackages = 1;
	    $autoscansources = 1;
	}
	elsif (/^-x$/ || /^--index$/) {
	    $indexall = 1;
	}
	elsif (/^-s$/ || /^--scandetect$/) {
	    if (-x "/usr/bin/apt-ftparchive") {
		$indexall = 1;
	    }
	    else {
		if (-x "/usr/bin/dpkg-scansources") {
		    $autoscansources = 1;  
		}
		if (-x "/usr/bin/dpkg-scanpackages") {
		    $autoscanpackages = 1;  
		}
	    }
	}
	elsif (/^-b$/ || /^--bzip$/) {
	    $bzip = 1;
	}
	elsif (/^--distinputcriteria/) {
	    $distinputcriteria = shift @ARGS2;
	}
	elsif (/^--scanall$/) {
	    $scanall = 1;
	}
	elsif (/^--autoscanall$/) {
	    $scanall = 1;
	    $autoscanpackages = 1;
	    $autoscansources = 1;
	}
	elsif (/^--scanonly$/) {
	    undef $sortpackages;
	    undef $fixstructure;
	}
	elsif (/^--ignoredestcheck$/) {
	    $ignoredestcheck = 1;
	}
	elsif (/^--nosort$/) {
	    undef $sortpackages;
	}
	elsif (/^--nostructurefix$/) {
	    undef $fixstructure;
	}
	else {
	    pdebug(2, "Unknown option $_\n");
	}
    }
    else {
	pdebug(2, "Unknown option $_\n");
    }
}

###############################################################################
############################# START ###########################################
###############################################################################

###############################################################################
# Now create the directory structure and files that are needed.
###############################################################################

handleStructureFix();

###############################################################################
# Fix so that it scan all distributions, sections and so on.
###############################################################################

if (defined $scanall) {
    handleScanAll();
}

###############################################################################
# Sort packages.
###############################################################################

handleSorting();

if (defined $indexall) {
    handleIndex();
} else {
    handleScan();
}

###############################################################################
########################### FUNCTIONS #########################################
###############################################################################

###############################################################################
# Name:		createPF
# Description:	Create the directory and file if it does not exist,
#		including the .gz file.
# Arguments:	directory, filename
# Changelog:
#  2001-07-14 Ola Lundqvist <ola@inguza.com>
#	Written.
###############################################################################

sub createPF($$) {
    my ($dir, $file) = @_;
    if (! -d "$dir") {
	action(! mkpath($dir, 0, 0755),
	       "Create directory $dir",
	       2);
    }
    if (! -e "$dir/$file") {
	cmdaction("touch $dir/$file",
		  "Create file $dir/$file.",
		  2);
    }
    if (! -e "$dir/${file}.gz") {
	cmdaction("gzip -c $dir/$file > $dir/${file}.gz",
		  "Create file $dir/$file.gz from $dir/$file.",
		  3);
    }
}

###############################################################################
# Name:		createRelease
# Description:	Create a Release file.
# Arguments:	directory, distribution, section, architecture
# Uses:         %release
# Changelog:
#  2004-08-09 Ola Lundqvist <ola@inguza.com>
#	Written.
#  2004-08-10 Ola Lundqvist <ola@inguza.com>
#	Renamed $release to $contents. Don't generate if any under a symlink.
###############################################################################

sub createRelease($$$$) {
    my ($dir, $distribution, $section, $architecture) = @_;
    my $contents = '';
    $contents .= "Archive: $distribution\n";
    $contents .= "Component: $section\n";
    $contents .= "Label: $release{label}\n" if defined $release{label};
    $contents .= "Origin: $release{origin}\n" if defined $release{origin};
    $contents .= "Architecture: $architecture\n";
    $contents .= "Description: $release{description}\n"
	if defined $release{description};
    $contents .= "\n";

    # Don't generate a Release file if any level of the directory is a symlink,
    # since otherwise for a testing -> unstable symlink, we'll keep regenerating
    # the Release file, first for testing and then for unstable.  Assume that
    # we'll also be called with the non-symlink path and create the Release file
    # then.
    my @components = split('/', $dir);
    for (my $i = 0; $i < @components; $i++) {
	my $testdir = join ('/', @components[0..$i]);
	if (-l "$testdir") {
	    return;
	}
    }

    # If the release file already exists, read it to see if anything has
    # changed.  Don't recreate the file unless we're actually changing anything,
    # to avoid unnecessary timestamp updates.
    if (-e "$dir/Release") {
	action(! open(REL, "$dir/Release"), "Read Release file in $dir", 2);
	local $/;
	my $old = <REL>;
	close REL;
	if ($contents ne $old) {
	    action(! open(REL, "> $dir/Release"), "Update Release file in $dir", 2);
	    print REL $contents;
	    close REL;
	}
    } else {
	action(! open(REL, "> $dir/Release"), "Create Release file in $dir", 2);
	print REL $contents;
	close REL;
    }
}

###############################################################################
######################### EMAIL HANDLING ######################################
###############################################################################

###############################################################################
# Name:		determineMailTo
# Description:	Determine the address to set mail to.
# Uses:		%CConf, %CMeta hash.
# Changelog:
#  2003-02-12	Ola Lundqvist <ola@inguza.com>
#	Wrote it.
#  2003-02-13	Ola Lundqvist <ola@inguza.com>
#	Extended it with @hostname calculation.
#  2003-02-28 Ola Lundqvist <ola@inguza.com>
#	Added debugging information.
#  2003-03-14 Ola Lundqvist <ola@inguza.com>
#	Switched to using CMeta for ChangeLog meta information.
#  2003-06-10 Ola Lundqvist <ola@inguza.com>
#	Switched from direct determination of changes owner to use
#	precalculated data from CMeta{FileOwner}.
#  2007-10-09 Turbo Fredriksson <turbo@bayour.com>
#       Change in foreach to use my variable.
###############################################################################

sub determineMailTo() {
    my $to = "";
    my %to_hash;
    foreach my $toi (@mailtos) {
	# Expand to email if there is no email address.
	if ($toi !~ /\@/) {
	    $toi = $CConf{$toi};
	}
	# Expand to full email address from @hostname field.
	if ($toi =~ /^\@/) {
	    $toi = "$CMeta{FileOwner}$toi";
	    # If still the same...
	    if ($toi =~ /^\@/) {
		pdebug(3, "No file owner has been determined, so email address can not be calculated.");
		$toi = "";
	    }
	}
	if ($toi !~ /^\s*$/) {
	    $to_hash{$toi} = "";
	}
    }
    pdebug(5, "Mail will be sent to $to.");
    return join(", ", keys(%to_hash));
}

###############################################################################
# Name:		email
# Description:	Send an email to persons, for package with message.
# Arguments:	to, package, key, message
# Changelog:
#  2002-09-11 Ola Lundqvist <ola@inguza.com>
#	Stub written.
#  2003-02-12 Ola Lundqvist <ola@inguza.com>
#	Writen the mail sending function.
#  2003-02-28 Ola Lundqvist <ola@inguza.com>
#	Added debugging information and fixed arg handling.
#  2003-03-13 Ola Lundqvist <ola@inguza.com>
#	Debugged the mail command. It stalls.
#  2007-10-08 Ola Lundqvist <ola@inguza.com>
#       Make it possible to specify mail sender.
###############################################################################

sub email($$$$) {
    my ($to, $package, $key, $message) = @_;
    if (length($to) > 0) {
	pdebug(5, "Executing mail command, $mailcmd -s '$package $key' $to.");
	if ($mailfrom ne "") {
	    if (open(M, "|$mailcmd -s '$package $key' '$to' -- -f '$mailfrom'")) {
		print M $message;
		close(M);
	    }
	    else {
		pdebug(2,
		       "Error executing mail command, $mailcmd -s '$package $key' '$to' -- -f '$mailfrom'.");
	    }
	    pdebug(5, "Mail exec done.");
	}
	else {
	    if (open(M, "|$mailcmd -s '$package $key' '$to'")) {
		print M $message;
		close(M);
	    }
	    else {
		pdebug(2,
		       "Error executing mail command, $mailcmd -s '$package $key' '$to'.");
	    }
	    pdebug(5, "Mail exec done.");
	}
    }
    else {
	pdebug(3, "No one to send mail to.");
    }
}

###############################################################################
# Name:		mailSuccess
#		including the .gz file.
# Uses:		%CMeta and maybe %Cfiles in the future.
# Changelog:
#  2002-09-11	Ola Lundqvist <ola@inguza.com>
#	Written.
#  2003-02-12	Ola Lundqvist <ola@inguza.com>
#	Uses CConf instead of cfile argument.
#  2003-03-14 Ola Lundqvist <ola@inguza.com>
#	Switched to using CMeta for ChangeLog meta information.
###############################################################################

sub mailSuccess() {
    # OOPS! We can not read that file after it has been moved!
    my $message = $CMeta{ChangesContent};
    pdebug(5, "Mail Success.");
    email(determineMailTo(),
	  $CConf{'Source'},
	  "ACCEPTED",
	  $message);
}

###############################################################################
# Name:		mailReject
# Uses:		%CMeta and maybe %Cfiles in the future.
# Changelog:
#  2002-09-12	Ola Lundqvist <ola@inguza.com>
#	Written using data from mailSuccess.
#  2003-02-12	Ola Lundqvist <ola@inguza.com>
#	Uses CConf instead of cfile argument.
#  2003-03-14   Ola Lundqvist <ola@inguza.com>
#	Switched to using CMeta for ChangeLog meta information.
#  2007-10-08   Turbo Fredriksson <turbo@bayour.com>
#       Error string in beginning and full message (+= => .=).
###############################################################################

sub mailReject() {
    # OOPS! We can not read that file after it has been moved!
    my $message;
    if (length($CConf{ERROR}) > 0) {
	$message = "ERROR:\n$CConf{ERROR}\n";
    }
    $message .= $CMeta{ChangesContent};

    pdebug(5, "Mail Reject.");
    email(determineMailTo(),
	  $CConf{'Source'},
	  "REJECTED",
          $message);
}

###############################################################################
########################### HANDLERS ##########################################
###############################################################################

###############################################################################
# Name:		handleScanAll
# Description:	Fix so that it scan all distributions, sections and so on.
# Changes:	%dests
# Uses:		@distributions, @sections, @architectures, $destdir.
# Changelog:
#  2001-07-23 Ola Lundqvist <ola@inguza.com>
#	Written.
#  2007-10-09 Turbo Fredriksson <turbo@bayour.com>
#       Change in foreach to use my variable.
###############################################################################

sub handleScanAll() {
    foreach my $d (@distributions) {
	foreach my $s (@sections) {
	    if (-e "$destdir/$d/$s/override") {
		foreach my $a (@architectures) {
		    $dests{"$d/$s/binary-$a"} = 1;
		}
		$dests{"$d/$s/binary-all"} = 1;
	    }
	    if (-e "$destdir/$d/$s/override.src") {
		$dests{"$d/$s/source"} = 1;
	    }
	}
    }
}

###############################################################################
# Name:		handleScan
# Description:	Handles the autoscan.
# Uses:		%dests, $destdir,
#		$autoscanpackages, $autoscansources.
# Changes:	$ENV{PWD}
# Changelog:
#  2001-06-26 Ola Lundqvist <ola@inguza.com>
#	Written.
#  2001-07-23 Ola Lundqvist <ola@inguza.com>
#	Added lockfile check to distr directory.
#	Improved documentation.
#  2002-01-22 Ola Lundqvist <ola@inguza.com>
#	Moved lock file checking to its own function.
#  2003-02-12 Ola Lundqvist <ola@inguza.com>
#	Now redirects stderr to stdout for
#	dpkg-scan* so that it can be logged.
#  2005-05-01 Daniel Leidert <daniel.leidert.spam@gmx.net>
#	Modified to add bzip2 support.
#  2005-05-02 Ola Lundqvist <ola@inguza.com>
#	Bugfix for bzip2 support.
###############################################################################

sub handleScan() {
    if (defined $autoscansources || defined $autoscanpackages) {
	$destdir =~ s|/$||;

	action(! chdir $destdir, "Change to dir $destdir", 2);
	&destinationLock();

	my $destddir = $destdir;
	$destddir =~ s|^.*/([^/]+)$|$1|;
	my $destcdir = $destdir;
	$destcdir =~ s|^(.*)/[^/]+$|$1|;
	action(! chdir $destcdir, "Change to dir $destcdir", 2);

	foreach $_ (keys %dests) {
	    my $archdest = $_;
	    $archdest = "$destddir/$archdest";
	    my $over = $_;
	    $over =~ s/^(.*)\/[^\/]+$/$1/;
	    $over = "$destddir/$over";
	    if ($archdest =~ /source$/ && defined $autoscansources) {
		cmdaction("dpkg-scansources $archdest $over/override.src 2>&1 > $archdest/Sources",
			  "Scan source files in $archdest, $over/override.src",
			  3);
		cmdaction("gzip $archdest/Sources -c > $archdest/Sources.gz",
			  "Zip it",
			  3);
		if ($bzip) {
		    cmdaction("bzip2 $archdest/Sources -c > $archdest/Sources.bz2",
			      "BZip it",
			      3);
		}
	    }
	    elsif (defined $autoscanpackages) {
		cmdaction("dpkg-scanpackages $archdest $over/override 2>&1 > $archdest/Packages.gen",
			  "Scan package files in $archdest, $over/override",
			  3);
		if ($archdest =~ /binary-all$/) {
		    opendir DD, $over;
		    my $d;
		    while ($d = readdir(DD)) {
			if (! ($d =~ /^binary-all/) &&
			    $d =~ /^binary-/ &&
			    -d "$over/$d") {
			    if (-f "$over/$d/Packages.gen") {
				cmdaction("cat $over/$d/Packages.gen $archdest/Packages.gen > $over/$d/Packages",
					  "Concatenate packages files from binary-all and $d.",
					  3);
			    }
			    else {
				cmdaction("cat $archdest/Packages.gen > $over/$d/Packages",
					  "Copy packages file from binary-all to $d.",
					  3);
			    }
			    cmdaction("gzip $over/$d/Packages -c > $over/$d/Packages.gz",
				      "Zip it",
				      3);
			    if ($bzip) {
				cmdaction("bzip2 $over/$d/Packages -c > $over/$d/Packages.bz2",
					  "BZip it",
					  3);
			    }
			}
		    }
		    closedir DD;
		}
		else {
		    if (-f "$over/binary-all/Packages.gen") {
			cmdaction("cat $archdest/Packages.gen $over/binary-all/Packages.gen > $archdest/Packages",
				  "Concatenate packages files from binary-all and $d.",
				  3);
		    }
		    else {
			cmdaction("cat $archdest/Packages.gen > $archdest/Packages",
				  "Copy packages file from $d.",
				  3);
		    }
		    cmdaction("gzip $archdest/Packages -c > $archdest/Packages.gz",
			      "Zip it",
			      3);
		    if ($bzip) {
			cmdaction("bzip2 $archdest/Packages -c > $archdest/Packages.bz2",
				  "BZip it",
				  3);
		    }
		}
	    }
	}

	&destinationRelease();
    }
}

###############################################################################
# Name:		findSectionsArchitectures
# Description:	Find sections and architectures in a distribution.
# Arguments:    Path to distribution directory to check,
#               reference to section array to fill out,
#               reference to architectures array to fill out
# Changelog:
#  2004-08-10 Ola Lundqvist <ola@inguza.com>
#      Written.
#  2007-10-09 Turbo Fredriksson <turbo@bayour.com>
#       Change in foreach to use my variable.
###############################################################################

sub findSectionsArchitectures($\@\@) {
    my ($dir, $sectionlist, $archlist) = @_;
    my (%dirsections, %dirarches);
    foreach my $s (@sections) {
	if (-e "$dir/$s/override") {
	    foreach my $a (@architectures) {
		$dirarches{$a} = 1;
	    }
	    $dirarches{all} = 1;
	    $dirsections{$s} = 1;
	}
	if (-e "$dir/$s/override.src") {
	    $dirarches{source} = 1;
	    $dirsections{$s} = 1;
	}
    }

    # Do things this way so that the lists are in the same order as @sections
    # and @architectures.  Purely aesthetic.
    @$sectionlist = grep { $dirsections{$_} } @sections;
    @$archlist = grep { $dirarches{$_} } @architectures, 'all', 'source';
}

###############################################################################
# Name:		generateIndexConfig
# Description:	Generate an apt-ftparchive configuration for the archive.
# Uses:		%dests, $destdir, $cachedir
# Returns:      Path to the generated config file
# Changelog:
#  2004-08-10 Ola Lundqvist <ola@inguza.com>
#	Written.
#  2005-05-01 Daniel Leidert <daniel.leidert.spam@gmx.net>
#	Modified to add bzip2 support.
#  2005-05-02 Ola Lundqvist <ola@inguza.com>
#	Bugfix for bzip2 support.
#  2007-10-09 Turbo Fredriksson <turbo@bayour.com>
#       Change in foreach to use my variable.
###############################################################################

sub generateIndexConfig() {
    my $destcdir = $destdir;
    $destcdir =~ s|^(.*)/[^/]+$|$1|;

    my $configpath = "$destdir/.apt-ftparchive.conf";
    action(! open(CONF, "> $configpath"), "Create apt-ftparchive config", 2);

    # The common header.
    print CONF "Dir {\n";
    print CONF "  ArchiveDir \"$destcdir\";\n";
    print CONF "  Cachedir \"$cachedir\";\n";
    print CONF "};\n\n";
    print CONF "Default {\n";
    print CONF "  Packages::Compress \". gzip bzip2\";\n"
	if ($bzip);
    print CONF "  Sources::Compress \". gzip bzip2\";\n"
	if ($bzip);
    print CONF "  Contents::Compress \". gzip\";\n";
    print CONF "};\n\n";
    print CONF "TreeDefault {\n";
    print CONF "  BinCacheDB \"cache.db\";\n";
    print CONF "  Release::Origin \"$release{origin}\";\n"
	if defined $release{origin};
    print CONF "  Release::Label \"$release{label}\";\n"
	if defined $release{label};
    print CONF "};\n\n";

    # The keys of %dests are all of the distribution/section/arch paths that
    # were modified in this run.  We can have apt-ftparchive only index the
    # distributions that were changed, but we have to reindex the entire
    # distribution, since otherwise the Contents files won't be accurate.  Find
    # all affected distributions from %dests, but then locate all sections and
    # architectures under there using the handleScanAll logic.  Skip
    # distributions that are symlinks so that we don't index the same
    # distribution more than once.
    my %changedist = map { s%/.*%%; $_ => 1 } keys %dests;
    foreach my $d (keys %changedist) {
	my $codename = $distmapping{$d} || $d;
	next if -l "$destdir/$codename";
	print CONF "Tree \"dists/$d\" {\n";
	my (@dsections, @darches);
	&findSectionsArchitectures("$destdir/$d", \@dsections, \@darches);
	print CONF "  Sections \"", join (' ', @dsections), "\";\n";
	print CONF "  Architectures \"", join (' ', @darches), "\";\n";
	print CONF "  Release::Suite \"$d\";\n";
	print CONF "  Release::Codename \"$codename\";\n";
	print CONF "};\n\n";
    }
    close CONF;
    return $configpath;
}

###############################################################################
# Name:		handleRelease
# Description:	Handles creation of Release files via apt-ftparchive.
# Arguments:	Path to the directory to generate Release for
#		Archive suite this Release file is for
#		Reference to array of sections
#		Reference to array of architectures
# Uses:		%distmapping, %release, $gpgkey, $gpgpassfile
# Changelog:
#  2005-08-20 Russ Allbery <rra@stanford.edu>
#	Written.
#  2005-09-02 Joergen Haegg <jorgen.hagg@axis.com>
#       Unlink Relase.gpg before creation.
#  2005-09-09 Ola Lundqvist <ola@inguza.com>
#	Made it possible for gnupg to read passphrase from file.
#  2005-09-15 Daniel Leidert <daniel.leidert.spam@gmx.net>
#	Fix regarding $gpgpassfile.
#  2005-10-08 Ola Lundqvist <ola@inguza.com>
#	Now invokes a helper program to sign the files. It may be implemented
#	by some perl module but this solution was good enough.
#  2005-10-14 Daniel Leidert <daniel.leidert@wgdd.de>
#	No longer invokes a helper program. We run gpg in batch mode without
#	tty to work-around old problems.
#  2005-11-07 Russ Allbery <rra@stanford.edu>
#	Don't set batch mode unless the passphrase is obtained from a file;
#	otherwise running debarchiver interactively with a signing key that
#	has a passphrase silently fails.
###############################################################################

sub generateRelease($$\@\@) {
    my ($path, $suite, $dsections, $darches) = @_;
    my $codename = $distmapping{$suite} || $suite;

    # Judging from the Release file in the Debian archive, "all" and "source"
    # shouldn't be included.
    my @arches = grep { $_ ne 'all' && $_ ne 'source' } @$darches;

    # We can't use the same config as generate, since release wants the
    # variables set in a different place.
    my $configpath = "$path/.apt-ftparchive.conf";
    action(! open(CONF, "> $configpath"),
	   "Create apt-ftparchive Release config for $path", 2);
    my $prefix = 'APT::FTPArchive::Release';
    print CONF "${prefix}::Origin \"$release{origin}\";\n"
	if defined $release{origin};
    print CONF "${prefix}::Label \"$release{label}\";\n"
	if defined $release{label};
    print CONF "${prefix}::Description \"$release{description}\";\n"
	if defined $release{description};
    print CONF "${prefix}::Suite \"$suite\";\n";
    print CONF "${prefix}::Codename \"$codename\";\n";
    print CONF "${prefix}::Architectures \"", join (' ', @arches), "\";\n";
    print CONF "${prefix}::Components \"", join (' ', @$dsections), "\";\n";
    close CONF;

    # Do the generation and optional signing.
    unlink("$path/Release");
    cmdaction("apt-ftparchive -c $configpath release $path > Release",
	      "Generate Release file for $path",
	      3);
    cmdaction("mv Release $path/Release",
	      "Put Release for $path in the right location",
	      3);
    if ($gpgkey) {
        unlink("$path/Release.gpg");
    	if ($gpgpassfile) {
	    cmdaction("cat $gpgpassfile | gpg --batch --no-tty -a -b -s -u $gpgkey " .
	              "--passphrase-fd 0 -o $path/Release.gpg $path/Release",
		      "Signing Release file for $path with key '$gpgkey'",
		      3);
	}
	else {
	    cmdaction("gpg -a -b -s -u $gpgkey " .
	              "-o $path/Release.gpg $path/Release",
		      "Signing Release file for $path with key '$gpgkey'",
		      3);
	}
    }
    unlink("$configpath");
}

###############################################################################
# Name:		handleIndex
# Description:	Handles the indexing via apt-ftparchive.
# Uses:		%dests, $destdir
# Changes:	$ENV{PWD}
# Changelog:
#  2004-07-30 Ola Lundqvist <ola@inguza.com>
#	Written.
#  2004-08-09 Ola Lundqvist <ola@inguza.com>
#	Add merging of binary-all Packages file.
#  2005-05-01 Daniel Leidert <daniel.leidert.spam@gmx.net>
#	Modified to add bzip2 support and handle contents-all in a proper way.
#  2005-05-02 Ola Lundqvist <ola@inguza.com>
#	Bugfix for bzip2 support.
#  2005-08-20 Russ Allbery <rra@stanford.edu>
#       Call generateRelease for Release file support (optionally signed).
#  2007-10-09 Turbo Fredriksson <turbo@bayour.com>
#       Change in foreach to use my variable.
###############################################################################

sub handleIndex() {
    $destdir =~ s|/+$||;

    action(! chdir $destdir, "Change to dir $destdir", 2);
    &destinationLock();

    my $aptconfig = &generateIndexConfig();
    cmdaction("apt-ftparchive generate $aptconfig",
	      "Index source and package files in $destdir",
	      3);
    unlink($aptconfig);

    # apt-ftparchive doesn't correctly combine binary-all/Packages with
    # binary-arch/Packages, so we have to patch it up after the fact.
    # apt-ftparchive reindexes the whole distribution when anything in that
    # distribution is touched, so find modified distributions and then touch up
    # the Packages files for each section and architecture under there.
    #
    # Remove binary-all/Packages after we finish with all architectures for a
    # section, so as to not append to Packages more than once even if we revist
    # the same area twice due to a symlink.
    my %changedist = map { s%/.*%%; $_ => 1 } keys %dests;
    foreach my $d (keys %changedist) {
	my (@dsections, @darches);
	&findSectionsArchitectures("$destdir/$d", \@dsections, \@darches);
	if (-s "$d/Contents-all") {
	    foreach my $a (@darches) {
		next if ($a eq 'source' || $a eq 'all');
		action(! open(ARCH, ">> $d/Contents-$a"),
		       "Append to $d/Contents-$a",
		       2);
		action(! open(ALL, "$d/Contents-all"),
		       "Read $d/Contents-all",
		       2);
		print ARCH <ALL>;
		close ALL;
		close ARCH;
		cmdaction("gzip $d/Contents-$a -c > $d/Contents-$a.gz",
			  "Compress merged Contents files",
			  3);
	    }
	}
	unlink("$d/Contents-all", "$d/Contents-all.gz");
	foreach my $s (@dsections) {
	    if (-s "$d/$s/binary-all/Packages") {
		foreach $_ (@darches) {
		    $a = $_;
		    next if ($a eq 'source' || $a eq 'all');
		    $a = "binary-$a";
		    action(! open(ARCH, ">> $d/$s/$a/Packages"),
			   "Append to $d/$s/binary-$a/Packages",
			   2);
		    action(! open(ALL, "$d/$s/binary-all/Packages"),
			   "Read $d/$s/binary-all/Packages",
			   2);
		    print ARCH <ALL>;
		    close ALL;
		    close ARCH;
		    cmdaction("gzip $d/$s/$a/Packages -c > $d/$s/$a/Packages.gz",
			      "Compress merged Packages file with gzip",
			      3);
		    if ($bzip) {
			cmdaction("bzip2 $d/$s/$a/Packages -c > $d/$s/$a/Packages.bz2",
				  "Compress merged Packages file with bzip2",
				  3);
		    }
		}
	    }
	    unlink("$d/$s/binary-all/Packages", "$d/$s/binary-all/Packages.gz",
		   "$d/$s/binary-all/Packages.bz2");
	}

	# This has to be done after we integrate the Packages files.
	generateRelease($d, $d, @dsections, @darches);
    }

    &destinationRelease();
}

###############################################################################
# Name:		handleSorting
# Arguments:	signature checking, override distribution(s) (optional)
# Description:	Sort packages into the right place.
# Uses:		parseChangesFile, verifyChangesFile, handleChangesFile
# Changelog:
#  2005-05-01 Ola Lundqvist <ola@inguza.com>
#	Written using parts of handleSorting.
#	Improved changes file verification structure.
#  2005-05-06 Daniel Leidert <daniel.leidert@wgdd.de>
#       Add arg to handle signature verification in inputdir and distinput-dirs
#       independetly.
#  2006-11-24 Håkon Stordahl <haastord@online.no>
#       Substituted the call to rejectChangesFile with a call to pdebug,
#       to explicitly trigger the error handler incomingError, which
#       itself contains a call to rejectChangesFile. This is in order
#       to avoid a situation in which an error in rejectChangesFile
#       causes rejectChangesFile to be called again.
###############################################################################

sub findAndSortChangesFiles($;$) {
    my ($verify, $override) = @_;
    opendir(D, ".");
    
    my $found = 1;
    my $cfile;
    # Loop again to make sure that no new .changes files have been uploaded.
    while ($found) {
	# go through all .changes files:
	$found = 0;
	while($cfile = readdir(D)) {
	    # Only .changes files.
	    if ($cfile =~ /\.changes$/) {
		parseChangesFile($cfile);
		uploaderIsChangesFileOwner($cfile);
		my ($verify, $reason) = verifyChangesFile($cfile, $verify);
		if ($verify =~ /^reject$/) {
		    # Reject .changes file by calling pdebug with error
                    # level 2, which in turn calls the error handler
                    # for this function, incomingError, which calls
                    # rejectChangesFile.
                    pdebug(2, "Rejecting $cfile.");
		}
		elsif ($verify =~ /^incomplete$/) {
		    # Handle incomplete .changes file.
		}
		else {
		    # Changes file verified.
		    $CConf{Distribution} = $override if ($override !~ /^\s*$/);
		    handleChangesFile($cfile);
		    $found = 1;
		}
	    }
	}
    }
    
    closedir(D);
}

###############################################################################
# Name:		handleSorting
# Description:	Sort packages into the right place.
# Changelog:
#  2001-07-23 Ola Lundqvist <ola@inguza.com>
#	Moved from START section to this subprocedure.
#  2005-04-xx Bob Proulx <bob@proulx.com>
#	Added support for .changes files in distinputdir.
#  2005-04-30 Ola Lundqvist <ola@inguza.com>
#	Modified support for .changes files in distinput dir.
#  2005-05-01 Ola Lundqvist <ola@inguza.com>
#	Broke out .changes file handling to a separate function
#	findAndSortChangesFiles.
#  2005-05-06 Daniel Leidert <daniel.leidert@wgdd.de>
#       Add signatur checking setting to arguments given to
#       findAndSortChangesFiles().
#  2007-10-09 Turbo Fredriksson <turbo@bayour.com>
#       Change in foreach to use my variable.
# Uses:		A lot.
###############################################################################

sub handleSorting() {
    if (defined $sortpackages) {
	# First check if a lockfile is created.

	action(! chdir $inputdir, "Change to dir $inputdir", 2);
	&incomingLock();

	# Look in the incoming directory for .changes files.
	findAndSortChangesFiles($verifysignatures);

	# Look in the incoming/<queue> directories for either .changes
	# files or for plain .debs matching the dist input criteria.

	foreach my $dir (keys %distinputdirs) {
	    my $inpdir = "$inputdir/$distinputdirs{$dir}";
	    if (-d $inpdir) {
		action(! chdir "$inpdir", "Change to dir $inpdir", 2);
		findAndSortChangesFiles($verifysignaturesdistinput, $dir);
		opendir(D, ".");
		my $file;
		while (defined($file = readdir(D))) {
		    if ($file =~ /$distinputcriteria/) {
			# We can add checks here to check for incomplete .changes files
			# se we do not sort .deb files that is a part of a .changes file.
			handleDebOnlyFile($file, $dir);
		    }
		}
		closedir(D);
	    }
	}

	action(! chdir $inputdir, "Change to dir $inputdir", 2);
	&incomingRelease();
    }
}

###############################################################################
# Name:		handleStructureFix
# Description:	Fix the distribution directory structure.
# Uses:		@distributions, @sections, @architectures, $fixstructure
# Changelog:
#  2001-07-23 Ola Lundqvist <ola@inguza.com>
#	Moved from START section to this subprocedure.
#  2004-08-09 Ola Lundqvist <ola@inguza.com>
#	Call createRelease to build Release files.
#  2007-10-08 Turbo Fredriksson <turbo@bayour.com>
#       Distmapping for files.
###############################################################################

sub handleStructureFix() {
    action(! chdir $destdir, "Change to dir $destdir", 2);

    if (defined $fixstructure) {
	my ($di, $se, $ar);
	for $di (@distributions) {
	    my $dis = $distmapping{$di} || $di;
	    if (! defined($dis)) {
		$dis = $di;
	    }
	    elsif ($dis =~ /^\s*$/) {
		$dis = $di;
	    }
	    if ((! -l "$di") &&
		$dis !~ /^$di$/) {
		cmdaction("ln -s $dis $di",
			  "Link $dis to $di.",
			  2);
	    }
	    for $se (@sections) {
		if (! -d "$dis/$se/binary-all") {
		    action(! mkpath("$dis/$se/binary-all", 0, 0755),
			   "Create binary-all directory $dis/$se/binary-all",
			   2);
		}
		for $ar (@architectures) {
		    createPF("$dis/$se/binary-$ar", "Packages");
		    createRelease("$dis/$se/binary-$ar", $di, $se, $ar);
		}
		createPF("$dis/$se/source", "Sources");
		createRelease("$dis/$se/source", $di, $se, 'source');
		if (! -e "$dis/$se/override") {
		    cmdaction("touch $dis/$se/override",
			      "Create file $dis/$se/override.",
			      2);
		}
		if (! -e "$dis/$se/override.src") {
		    cmdaction("touch $dis/$se/override.src",
			      "Create file $dis/$se/override.src.",
			      2);
		}
	    }
	}
    }
}

###############################################################################
# Name:		handleDebOnlyFile
# Description:	Handles installation of a deb image.
# Arguments:	A deb file.
#		The distribution to install to.
# Changes:	see parseKernelFile
# Changelog:
#  2001-06-29 Ola Lundqvist <ola@inguza.com>
#	Written.
#  2007-10-09 Turbo Fredriksson <turbo@bayour.com>
#       Change in foreach to use my variable.
###############################################################################

sub handleDebOnlyFile($$) {
    my ($kfile, $distr) = @_;

    parseDebOnlyFile($kfile, $distr);
    foreach my $file (keys %CFiles) {
	handlePackageFile($file);
    }
}

###############################################################################
# Name:		checkFileInDestDirs
# Description:  Check the location of the file in the dest dirs.
###############################################################################
# Uses: parseFileName
#       parseFileStruct
#	parseSection
#       %CConf
#       %CFiles
#       %distmapping
# Arguments:
#	filename to check for
# Returns:
#	filepath     If file exist in dest dirs.
#       ""           If file not found.
# Changelog:
#  2007-10-08 Ola Lundqvist <ola@inguza.com>
#       Write function based on the code from Turbo Fredriksson <turbo@bayour.com>
#       in function verifyChangesFile below.
#  2007-10-09 Turbo Fredriksson <turbo@bayour.com>
#       Change in foreach to use my variable.
###############################################################################

sub checkFileInDestDirs($) {
    my ($file) = @_;
    my (undef, undef, $section, undef) = parseFileStruct($CFiles{$file});
    my ($major, $section) = parseSection($section);

    my $distrd = $CConf{Distribution};
    my $inst_files = "";

    foreach my $distr (split /\s+/, $distrd) {
	$distr = $distmapping{$distr} || $distr;
	my (undef, undef, $arch, undef) = parseFileName($file);
	
	my $archsec = "source";
	if ($arch !~ /^source$/) {
	    $archsec = "binary-$arch";
	}
	
	my $inst_file = "$destdir/$distr/$major/$archsec/$section/$file";
	if (-f "$inst_file") {
	    if ($inst_files eq "") {
		$inst_files = $inst_file;
	    }
	    else {
		$inst_files .= " $inst_file";
	    }
	}
    }
    return $inst_files;
}

###############################################################################
# Name:		getMD5HashForFile	
# Description:  Get the MD5 hash for a file. File must exist.
###############################################################################
# Uses:
#	Digest::MD5
# Arguments:
#	filename to check for
# Returns:
#	MD5 sum for file
# Changelog:
#  2007-10-08 Ola Lundqvist <ola@inguza.com>
#       Write function based on the code from Turbo Fredriksson <turbo@bayour.com>
#       in function verifyChangesFile below.
#  2007-10-09 Turbo Fredriksson <turbo@bayour.com>
#       Correction.
###############################################################################

sub getMD5HashForFile($) {
    my ($file) = @_;
    open(FILE, $file) or die "Can't open $file: $!\n";
    binmode(FILE);
    $digest = Digest::MD5->new->addfile(*FILE)->hexdigest, " $file\n";
    close (FILE);
    return $digest;
}

###############################################################################
# Name:		verifyChangesFile
# Description:	Parses the .changes file.
# Uses:		pdebug, uploaderIsChangesFileOwner
#		%CFiles
#			$filename => "$hash $size $section $type"
# Arguments:	The .changes file and the signature checking setting.
# Returns:	
#	incomplete	Incomplete upload.
#	reject		Reject a changes file.
#	ok		Else verification ok (anything except incomplete or reject).
# Changelog:
#  2005-04-xx Bob Proulx <bob@proulx.com>
#	Split out parts of handleChangesFile to this proc.
#  2005-05-01 Ola Lundqvist <ola@inguza.com>
#	Renamed from parseChangesFile to verifyChangesFile and removed parse
#	part. Rewrote parts to allow it to return some kind of status.
#	Added code to verify that changes file upload is complete.
#  2005-05-06 Daniel Leidert <daniel.leidert@wgdd.de>
#       Add arg to handle signature verification in inputdir and distinput-dirs
#       independetly.
#  2007-10-08 Turbo Fredriksson <turbo@bayour.com>
#       Stat only existing files.
#  2007-10-08 Ola Lundqvist <ola@inguza.com>
#       Correct indention (as Turbo explained).
#  2007-10-08 Turbo Fredriksson <turbo@bayour.com>
#       The changes file is only incomplete if the file is missing _and_
#       a file in the destination do not already exist with the correct MD5
#       hash.
#  2007-10-08 Ola Lundqvist <ola@inguza.com>
#       Extraced the file check to two own functions.
#       Changed the order to always check for installed files and reject if it
#       exist with wrong size or md5sum.
#  2007-10-09 Turbo Fredriksson <turbo@bayour.com>
#       Change in foreach to use my variable.
#       Check incomplete time only once.
#       Allow forcing an install of an upload (i.e., ignore existing files in
#       destdir).
#  2007-10-09 Ola Lundqvist <ola@inguza.com>
#       Changed force option to ignoredestcheck option.
###############################################################################

sub verifyChangesFile($$) {
    my ($cfile, $verify) = @_;
    # Get changes file owner uid
    my $cfowner = (stat $cfile)[4];
    my $clastmod = (stat $cfile)[9];
    my $old_changes = 0;
    if ($clastmod < time() - $incompletetime) {
	$old_changes = 1;
    }
    # Verify changelog so it is complete, ok is default.
    # If incomplete continue checking for errors.
    my $ret = "ok";
    foreach my $file (keys %CFiles) {
	# Does it exist in the destdir?
	my $inst_files = checkFileInDestDirs($file);
	if (($inst_files ne "") && ($ignoredestcheck == 0)) {
	    foreach my $inst_file (split / /, $inst_files) {
		# Get data for the file to install.
		my ($hash, $size, undef, undef) = parseFileStruct($CFiles{$file});
		# Get size for the already installed one
		my (undef, undef, undef, undef, undef, undef, undef, $ssize) = stat($inst_file);
		if ($size != $ssize) {
		    pdebug(4, "$cfile is rejected. $file already installed and size do not match.");
		    $CConf{ERROR} = "$CConf{ERROR}$cfile is rejected. $file already installed and size do not match.\n";
		    return "reject";
		}
		my $digest = getMD5HashForFile($inst_file);
		if ($hash != $digest) {
		    pdebug(4, "$cfile is rejected. $file already installed and MD5 sum do not match.");
		    $CConf{ERROR} = "$CConf{ERROR}$cfile is rejected. $file already installed and MD5 sum do not match.\n";
		    return "reject";
		}
	    }
	}
	elsif (! -f $file) {
	    # Modification time of the changesfile.
	    if ($old_changes) {
		pdebug(4, "$cfile is incomplete and is older than $incompletetime seconds.");
		$CConf{ERROR} = "$CConf{ERROR}$cfile is incomplete and is older than $incompletetime seconds.\n";
		return "reject";
	    } else {
		pdebug(4, "$cfile is incomplete. Missing file: $file.");
		$ret = "incomplete";
	    }
	} else {
	    # File exist, now verify it.
	    my (undef, undef, undef, undef, $fowner, undef, undef, $size) = stat($file);
	    if ($fowner != $cfowner) {
		pdebug(4,"$file owner ($fowner) do not match $cfile owner ($cfowner).");
		$CConf{ERROR} = "$CConf{ERROR}$file owner do not match $cfile owner.\n";
		return "reject";
	    }
	    my ($cfhash, $cfsize) = split / /, $CFiles{$file};
	    if ($size < $cfsize) {
		# Modification time of the changesfile.
		pdebug(4, "$cfile is incomplete and is older than $incompletetime seconds as $file is not of full size.");
		if ($old_changes) {
		    $CConf{ERROR} = "$CConf{ERROR}$cfile is incomplete and is older than $incompletetime seconds as $file is not of full size.\n";
		    return "reject";
		}
		else {
		    $ret = "incomplete";
		}
	    } elsif ($size > $cfsize) {
		pdebug(4, "$cfile upload is broken, $file is bigger than expected.");
		$CConf{ERROR} = "$CConf{ERROR}$cfile upload is broken, $file is bigger than expected.\n";
		return "reject";
	    }
	}
    }
    # Verify signatures.
    if ($verify) {
	if (system($vrfycmd,$cfile)) { # non-zero == verification failure
	    pdebug(4, "Signature verification failed for $cfile");
	    $CConf{ERROR} = "$CConf{ERROR}$vrfycmd was not able to verify $cfile.\n";
	    return "reject";
	}
    }
    return $ret;
}

###############################################################################
# Name:		handleChangesFile
# Description:	Handles the .changes file.
# Uses:		pdebug, $copycmd, $rmcmd
# Arguments:	The .changes file.
# Returns:	nothing
# Changelog:
#  2001-06-26 Ola Lundqvist <ola@inguza.com>
#	Taken from the main script. Cut and paste with simple changes.
#  2003-03-13 Ola Lundqvist <ola@inguza.com>
#	Added mailSuccess command thing.
#  2003-06-10 Ola Lundqvist <ola@inguza.com>
#	Now uses uploaderIsChangesFileOwner to make sure that the owner can be
#	calculated before the changes file will be moved or something similar.
#       Also added rejectChangesFile to vrfycmd so that messages will be sent
#	properly if it is rejected.
#       Moved parseChanges before sig verify and uploaderIsChangesFileOwner to
#	make sure that CMeta is created before that.
#  2005-04-xx Bob Proulx <bob@proulx.com>
#	Split out parts of this function to parseChangesFile.
#  2007-10-09 Turbo Fredriksson <turbo@bayour.com>
#       Change in foreach to use my variable.
###############################################################################

sub handleChangesFile($) {
    my ($cfile) = @_;

    foreach my $file (keys %CFiles) {
	handlePackageFile($file, $cfile);
    }
    installChangesFile($cfile);
    mailSuccess();
}

###############################################################################
# Name:		uploaderIsChangesFileOwner
# Description:	Sets CMeta{FileOwner} from 
# Changes:	CMeta
# Changelog:
#  2003-06-10 Ola Lundqvist <ola@inguza.com
#	Wrote it.
###############################################################################

sub uploaderIsChangesFileOwner($) {
    my ($cfile) = @_;
    my @temp = stat($cfile);
    if (@temp) {
	my $tmp = $temp[4];
	$CMeta{FileOwner} = getpwuid($tmp);
	pdebug(5, "$cfile is owned by $CMeta{FileOwner}");
    }
    else {
	pdebug(3, "Can not stat file $cfile, so unable to calculate email address.");
	$CMeta{FileOwner} = "";
    }
}

###############################################################################
# Name:		rejectChangesFile
# Description:	Reject the changes file so that it is moved away.
# Uses:		%CFiles, %CConf
# Changelog:
#  2003-02-12 Ola Lundqvist <ola@inguza.com
#	Wrote it.
#  2003-02-28 Ola Lundqvist <ola@inguza.com
#	Implemented the commands in the foreach loop.
#  2003-03-14 Ola Lundqvist <ola@inguza.com>
#	Switched to using CMeta for ChangeLog meta information.
#  2005-05-01 Ola Lundqvist <ola@inguza.com>
#	Modified reject cause.
#  2005-05-06 Daniel Leidert <daniel.leidert@wgdd.de>
#       Fixed move-command and check for .changes file.
#  2007-10-09 Turbo Fredriksson <turbo@bayour.com>
#       Change in foreach to use my variable.
#       Create reject log code.
#  2007-10-09 Ola Lundqvist <ola@inguza.com>
#       Moved reject log code to REJECT dir and changed coding style some.
###############################################################################

sub rejectChangesFile() {
    if (! -d "REJECT") {
	action(! mkpath ("REJECT", 0, 0775),
	       "Making REJECT directory.",
	       2);
    }
    if (-f $CMeta{ChangesFile}) {
		cmdaction("$movecmd $CMeta{ChangesFile} REJECT/",
		  "Move .changes to REJECT dir.",
		  2);
    }
    foreach my $file (keys %CFiles) {
	if (-f $file) {
	    cmdaction ("$movecmd $file REJECT/",
		       "Move $file to REJECT dir.",
		       3);
	}
	else {
	    $CConf{ERROR} = "$CConf{ERROR}File $file can not be moved because it is already installed (or incomplete upload).\n";
	}
    }
    # Create a reject log
    my $log = $CMeta{ChangesFile};
    $log =~ s/\.changes/\.reject/;
    $log = "REJECT/$log";
    if (open(LOG, "> $log")) {
	print LOG $CConf{ERROR};
	close(LOG);
    }
    else {
	pdebug(4, "Can't create reject log [$log].");
	$CConf{ERROR} = "$CConf{ERROR}Can't create reject log [$log].\n";
    }
}

###############################################################################
# Name:		handlePackageFile
# Description:	Handles the package file.
# Uses:		Same as parseChangesFile produces.
# Changes:	%dests
# Arguments:	The package file (the key in %CFiles).
# Returns:	nothing
# Changelog:
#  2001-06-26 Ola Lundqvist <ola@inguza.com>
#	Taken from the main script. Cut and paste with simple changes.
#  2006-06-11 Michael Hanke <michael.hanke@gmail.com>
#       Only remove source tarball file if not referenced by any other .changes file.
#  2006-07-20 Ola Lundqvist <ola@inguza.com>
#       Changed indentation.
#  2007-10-08 Turbo Fredriksson <turbo@bayour.com>
#       Distmapping for files.
#  2007-10-08 Turbo Fredriksson <turbo@bayour.com>
#       The changes file is only incomplete if the file is missing _and_
#       a file in the destination do not already exist with the correct MD5
#       hash.
#  2007-10-09 Turbo Fredriksson <turbo@bayour.com>
#       Change in foreach to use my variable.
###############################################################################

sub handlePackageFile ($) {
    my ($file, $cfile) = @_;
    my $distrd = $CConf{Distribution};

    pdebug(5, "File $_:  $CFiles{$file}");
    my ($hash, $size, $section, $prio) =
	parseFileStruct($CFiles{$file});
    my ($pkgname, $ver, $arch, $ext) =
	parseFileName($file);
    my $archsec = "source";
    if ($arch !~ /^source$/) {
	$archsec = "binary-$arch";
    }
    my ($major, $section) = parseSection($section);

    # OVERRIDES

    foreach my $distr (split /\s+/, $distrd) {
	$distr = $distmapping{$distr} || $distr;
	my $srcext = ".src" if ($arch =~ /^source$/);
	parseOverrideFile($distr, $major, $srcext);
	if (defined $Override{$distr, $major, "$pkgname$srcext"}) {
	    pdebug(5, "Defined in override, $pkgname$srcext");
	    $section = secondIfNotEmpty($section,
					$Override{$distr,
						  $major,
						  "$pkgname$srcext",
						  Section});
	}
	elsif (defined $addoverride) {
	    pdebug(5, "Add to override$srcext, $pkgname $prio $section");
	    open F, ">>$destdir/$distr/$major/override$srcext";
	    print(F  "$pkgname $prio $section\n");
	    close(F);
	    $Override{$distr,
		      $major,
		      "$pkgname$srcext"} = 1;
	}

	# Note to the autoscan that files are installed to this dir.
	$dests{"$distr/$major/$archsec"} = 1;

	my $installto = "$destdir/$distr/$major/$archsec/$section";
	if (! -d $installto) {
	    action(! mkpath ($installto, 0, 0755),
		   "Making directory $installto",
		   2);
	}
	elsif (-f $file) {
	    if ($arch =~ /^source$/) {
		cmdaction("$rmcmd $installto/${pkgname}_*$ext",
			  "Delete $installto/${pkgname}_*$ext",
			  2);
	    }
	    else {
		# This will not work but tells what to do.
		cmdaction("$rmcmd $installto/${pkgname}_*_$arch$ext",
			  "Delete $installto/${pkgname}_*_$arch$ext",
			  2);
	    }
	}
	cmdaction("$copycmd $file $installto",
		  "Installing $file to $installto.",
		  2);
	}
	# flag whether file should get deleted
	my $killfile = 1;
		
	# only do checks of processing source tarballs
        if ($file =~ m/.tar.gz$/) {
	    my @upstream_version = split(/-/, $ver);
	    $upstream_version = $upstream_version[0];
	    
	    # get list of remaining *.changes files of this package upstream 
	    # version
	    my @otherchangesfiles = <$inputdir/${pkgname}_$upver*.changes>;
	    
	    # check whether any of the remaining *.changes files does not match the 
	    # current package
	  CHGSPARSER: foreach my $otherchangesfile (@otherchangesfiles) {
	      if (!($otherchangesfile =~ $cfile)) {
		  open ( otherchangesfilehandle, $otherchangesfile);
		  
		  while ($line = <otherchangesfilehandle>) {
		      if ($line =~ m/${pkgname}_$upver.*\.tar\.gz/) {
			  pdebug(4, "Found additional package using the source tarball of the package. Will not delete it now!");
			  $killfile = 0;
			  close(otherchangesfilehandle);
			  last CHGSPARSER;
		      }
		  }
		  
		  close(otherchangesfilehandle)
		  }
	  }
	}
    
	if ($killfile) {
	    cmdaction("$rmcmd $file", 
		      "Removing $file after it has been installed.", 2);
	}
}

###############################################################################
# Name:		installChangesFile
# Description:	Moves the changes file to the right place, or remove it.
# Arguments:	The .changes file.
#		Where to place it.
# Returns:	($major, $section)
#		if on the form foo/bar it returns (foo, bar) and if it
#		is on the form foo it returns (main, foo).
# Changelog:
#  2001-06-10 Ola Lundqvist <ola@inguza.com>
#	Wrote it.
#  2003-03-14 Ola Lundqvist <ola@inguza.com>
#	Now CConf{ChangesFile} is changed when copying it.
#  2007-10-08 Turbo Fredriksson <turbo@bayour.com>
#       Distmapping for files.
#  2007-10-09 Turbo Fredriksson <turbo@bayour.com>
#       Change in foreach to use my variable.
###############################################################################

sub installChangesFile ($) {
    my ($cfile) = @_;

    my $distrd = $CConf{Distribution};
    foreach my $distr (split /\s+/, $distrd) {
	$distr = $distmapping{$distr} || $distr;
	my $todir = relativePath($cinstall, "$destdir/$distr");
	if ($cinstall !~ /^\s*$/) {
	    # Now remove or move away the .changes file (if $cinstall not empty).
	    if (! -d $todir) {
		action(! mkpath ($todir, 0, 0755),
		       "Making directory $todir",
		       2);
	    }
	    cmdaction("$copycmd $cfile $todir",
		      "Copy $cfile to $todir.",
		      2);
	}
    }
    cmdaction("$rmcmd $cfile",
	      "Remove changes file $cfile after installation.",
	      2);
}

###############################################################################
######################### LOCK HANDLERS #######################################
###############################################################################
# Changelog:
#  2006-11-24 Håkon Stordahl <haastord@online.no>
#       Tried to fix the error handler functions incomingError and
#       rejectError, by removing the lock file in rejectError instead
#       of incomingError, so the lock file is not removed immediately
#       after an error, but rather if another error occurs while
#       handling the error. Also added a call to exit in rejectError
#       so the program will terminate in this case.
#
#       Because of the chdir in handleSorting, the lock file name
#       needs to prefixed by $inputdir in the functions incomingError
#       and rejectError.
#
#       Restored the error handler in incomingError so subsequent
#       errors are treated in the same way.
#
#       Also moved the call to mailReject from the function rejectError
#       to the function incomingError, so a mail is sent each time
#       a .changes file is rejected. When called from rejectError,
#       which actually is the error handler of incomingError, which
#       itself is an error handler and calls rejectChangesFile, a mail
#       would only be sent if there was a problem with the rejection.
###############################################################################

sub incomingLock() {
    &createLockExit("$lockfile");
    &setErrorHandler(\&incomingError);
}

sub incomingRelease() {
    &setErrorHandler(undef);
    &removeLockfile("$lockfile");
}

sub incomingError() {
    &setErrorHandler(\&rejectError);    
    &rejectChangesFile();
    &mailReject();
    &setErrorHandler(\&incomingError);
}

sub rejectError() {
    &setErrorHandler(undef);
    &removeLockfile("$inputdir/$lockfile");    
    exit;
}

sub destinationLock() {
    &createLockExit("$destdir/$lockfile");
    &setErrorHandler(\&destinationError);
}

sub destinationRelease() {
    &setErrorHandler(undef);
    &removeLockfile("$destdir/$lockfile");
}

sub destinationError() {
    &setErrorHandler(undef);
    &removeLockExit("$destdir/$lockfile");    
}

###############################################################################
######################### LOCK FUNCTIONS ######################################
###############################################################################

###############################################################################
# Name:		createLockExit
# Description:	creates a lockfile, but exits if it can't.
# Changelog:
#  2002-01-22 Ola Lundqvist <ola@inguza.com>
#	Written.
# Arguments:   	$lockfile
# Returns:	nothing
###############################################################################

sub createLockExit($) {
    my ($lockfile) = @_;
    if (-e $lockfile) {
	pdebug(2, "Lockfile exists in distribution directory, skipping.");
    }
    cmdaction("touch $lockfile",
	      "Creating lockfile $lockfile",
	      2);
}

###############################################################################
# Name:		removeLockfile
# Description:	Removes the lockfile.
# Arguments:	none
# Needs:	$rmcmd $lockfile
# Returns:	nothing
# Changelog:
#  2002-01-22 Ola Lundqvist <ola@inguza.com>
#	Written.
###############################################################################

sub removeLockExit() {
    my ($lockfile) = @_;
    removeLockfile($lockfile);
    exit;
}

###############################################################################
# Name:		removeLockfile
# Description:	Removes the lockfile.
# Arguments:    $lockfile
# Returns:	nothing
# Changelog:
#  2002-01-22 Ola Lundqvist <ola@inguza.com>
#	Written.
###############################################################################

sub removeLockfile() {
    my ($lockfile) = @_;
    cmdaction("rm $lockfile",
	      "Removing lockfile $lockfile.",
	      2);
}

###############################################################################
############################ PARSERS ##########################################
###############################################################################

###############################################################################
# Name:		parseSection
# Description:	Takes a section and convert that into the used ones.
# Arguments:	A section on the form foo/bar or foo.
# Returns:	($major, $section)
#		if on the form foo/bar it returns (foo, bar) and if it
#		is on the form foo it returns (main, foo).
# Changelog:
#  2001-06-10 Ola Lundqvist <ola@inguza.com>
#	Written.
#  2006-02-25 Yaroslav Halchenko <debian@onerussian.com> and
#             Ola Lundqvist <ola@inguza.com>
#       Default major section function.
###############################################################################

sub parseSection($) {
    my ($major, $section) = split /\//, shift @_;
    if ($section =~ /^\s*$/) {
	# on the foo form.
	$section = $major;
	$major = $majordefault;
    }
    return ($major, $section);
}

###############################################################################
# Name:		parseFileStruct
# Description:	Parses a hash size section prio string.
#		It is a simple split...
# Arguments:	The string.
# Returns:	($hash, $size, $section, $prio)
# Changelog:
#  2001-06-10 Ola Lundqvist <ola@inguza.com>
#	Written.
###############################################################################

sub parseFileStruct($) {
    return split / /, shift @_;
}

###############################################################################
# Name:		parseFileName
# Description:	Parses a file name and splits into $pkgname, $version, $arch
# Arguments:	deb filename.
# Returns:	($pkgname, $version, $arch, $ext)
# Changelog:
#  2001-06-10 Ola Lundqvist <ola@inguza.com>
#	Written.
###############################################################################

sub parseFileName($) {
    my ($file) = @_;
    my ($pkgname, $ver, $arch) = split /_/, $file;
    $pkgname =~ s/^.*\///;
    my $ext;
    if ($arch !~ /^\s*$/) {
	$ext = $arch;
	$arch =~ s/\..*$//;
	$ext =~ s/^[^\.]*\./\./;
    }
    else {
	$ext = $ver;
	$ver = $CConf{Version};
	$ext =~ s/$ver//;
	$arch = "source";
    }
    return ($pkgname, $ver, $arch, $ext);
}

###############################################################################
# Name:		parseDebOnlyFile
# Description:	Parses a debian deb file and extracs the information in the
#		way that parseChangesFile does.
# Arguments:	A deb file name.
# Changes:	see parseChangesFile
# Changelog:
#  2001-06-29 Ola Lundqvist <ola@inguza.com>
#	Written with info from parseChanges.
#  2003-02-12 Ola Lundqvist <ola@inguza.com>
#	Added ChangesFile to CConf hash.
#  2007-10-09 Turbo Fredriksson <turbo@bayour.com>
#       Change in foreach to use my variable.
###############################################################################

sub parseDebOnlyFile($$) {
    my ($kfile, $distr) = @_;
    my $state = "";
    my $section;
    my $priority;
    my $size;
    my $desc;
    %CConf = (Distribution => $distr);
    %CMeta = (ChangesFile => "", ChangesContent => "");
    %CFiles = ();
    %CDesc = ();
    my @cmdres = readcommand("dpkg-deb -f $kfile");
    foreach my $line (@cmdres) {
	# The state to just put the line in the hash.
	if ($line =~ /^\s*$/) {
	    next;
	}
	$line =~ s/\n$//;
	if ($line =~ /^Provides:/ ||
	    $line =~ /^Suggests:/ ||
	    $line =~ /^Depends:/) {
	    #next;
	}
	elsif ($line =~ /^Package:/) {
	    $line =~ s/^[^:]*:\s//;
	    $CConf{Binary} = $line;
	}
	elsif ($line =~ /^Section:/) {
	    $line =~ s/^[^:]*:\s//;
	    $section = $line;
	}
	elsif ($line =~ /^Priority:/) {
	    $line =~ s/^[^:]*:\s//;
	    $priority = $line;
	}
	elsif ($line =~ /^Installed-Size:/) {
	    $line =~ s/^[^:]*:\s//;
	    $size = $line;
	}
	elsif ($line =~ /^Description:/) {
	    $line =~ s/^[^:]*:\s//;
	    $desc = $line;
	}
	elsif ($line =~ /^ ./) {
	    pdebug(6, "Do nothing with description.");
	}
	else {
	    my $pre = $line;
	    $pre =~ s/:.*$//;
	    $line =~ s/^[^:]*:\s//;
	    $CConf{$pre} = $line;
	}
    }
    $CDesc{$CConf{Binary}} = $desc;
    $CFiles{$kfile} = "0 $size $section $priority";
}

###############################################################################
# Name:		parseChangesFile
# Description:	Parses a debian changelog file and extracs the information.
# Arguments:	.changes file name.
# Changes:	
#	%CConf
#		'Format' => The file format.
#		'Source' => The source packages
#		'Binary' => The binary packages
#		'Architecture' => [source] [all] or other
#		'Version' => The packages version.
#		'Distribution' => The intended distribution.
#		'Urgency' => How urgent the package installation is.
#		'Maintainer' => The package maintainer.
#		'Uploaders' => The other package maintainers.
#		... => other undocumentated things that can be used.
#	%CMeta
#		'ChangesFile' => The file.
#		'ChangesContent' => The content of the ChangeLog file.
#	%CFiles
#		$filename => "$hash $size $section $type"
#	%CDesc
#		$pkgname => "The short description of the package."
# ChangeLog:
#  2001-06-10 Ola Lundqvist <ola@inguza.com>
#  	Written.
#  2001-06-26 Ola Lundqvist <ola@inguza.com>
#  	Changed print to pdebug.
#  2002-09-11 Ola Lundqvist <ola@inguza.com>
#	Added uploaders field to the description.
#  2003-02-12 Ola Lundqvist <ola@inguza.com>
#	Added ChangesFile to CConf hash.
#  2003-03-14 Ola Lundqvist <ola@inguza.com>
#	Switched to using CMeta for ChangeLog meta information.
#  2005-05-01 Ola Lundqvist <ola@inguza.com>
#	Renamed to parseChangesFile.
#  2006-03-25 Jrmy Bobbio <jeremy.bobbio@etu.upmc.fr>
#       One line fix for udeb support.
###############################################################################

sub parseChangesFile($) {
    my ($file) = @_;
    if ($file =~ /\|$/) {
	pdebug(2, "The changes file is not allowed to end in |, because that can cause a failure\nin the debarchiver program.");
    }
    open (F, $file);
    my $state = "";
    my $line;
    %CConf = ();
    %CMeta = (ChangesFile => $file, ChangesContent => "");
    %CFiles = ();
    %CDesc = ();
    while ($line = <F>) {
	$CMeta{ChangesContent} = $CMeta{ChangesContent} . $line;
	# The state to just put the line in the hash.
	if ($line =~ /^\s*$/) {
	    next;
	}
	$line =~ s/\n$//;
	if ($line =~ /^[^:]+:\s*$/) {
	    $line =~ s/^([^:]+):\s*$/$1/;
	    $state = $line;
	    pdebug(6, "State change to $state\n");
	}
	elsif ($line =~ /^\-+BEGIN PGP SIGNED MESSAGE\-+/) {
	    $state = "";
	    pdebug(6, "State change to normal state.\n");
	}
	elsif ($line =~ /^\-+BEGIN PGP SIGNATURE\-+/) {
	    $state = "PGP";
	    pdebug(6, "State change to $state\n");
	}
	elsif ($line =~ /^\-+END PGP SIGNATURE\-+/) {
	    $state = "END";
	    pdebug(6, "State change to $state\n");
	}
	# The default state.
	elsif ($state =~ /^$/) {
	    my $pre = $line;
	    $pre =~ s/:.*$//;
	    $line =~ s/^[^:]*:\s//;
	    $CConf{$pre} = $line;
	}
	# Description state.
	elsif ($state =~ /Description/) {
	    my ($pkg, $desc) = split /\s+\-\s+/, $line;
	    $pkg =~ s/^\s*//;
	    $desc =~ s/\s*$//;
	    $CDesc{$pkg} = $desc;
	    pdebug(6, "Saving desc '$desc' indexed by $pkg.\n");
	}
	# PGP Sign
	elsif ($state =~ /PGP/) {
	    pdebug(6, "Do nothing with $line\n");
	}
	# Changes state.
	elsif ($state =~ /Changes/) {
	    pdebug(6, "Do nothing with $line\n");
	}
	# Files state.
	elsif ($state =~ /Files/ && $line =~ /^ /) {
	    my @f = split / /, $line;
	    shift @f;
	    my $file = pop @f;
	    $CFiles{$file} = "$f[0] $f[1] $f[2] $f[3]";#[ @f ];
	    pdebug (6, "Saving file $file.\n");
	}
    }
}

###############################################################################
# Name:		parseOverrideFile
# Description:	Parses the override file.
# Arguments:	The distribution (like unstable)
#		The major dir (like main or contrib)
#		The src extention (undef or .src)
# Changes:	%Override	The override structure this overrides the
#				packages information.
# Changelog:
#  2001-06-26 Ola Lundqvist <ola@inguza.com>
#	Written.
#  2007-10-09 Turbo Fredriksson <turbo@bayour.com>
#       Change in foreach to use my variable.
###############################################################################

sub parseOverrideFile($$$) {
    my ($distr, $major, $srcext) = @_;
    my $def = ".pkg";
    if (defined $srcext && $srcext !~ /^\s*$/) {
	$def = $srcext;
    }
    pdebug(5, "override $def");
    if (! defined $Override{$distr, $major, $def}) {
	pdebug(5, "Load override file for $distr, $major");
	my $odir = "$destdir/$distr/$major";
	my @o = readfile("$odir/override$srcext");
	$Override{$distr,$major, $def} = 1;
	foreach my $tmp (@o) {
	    my ($pkg, $prio, $section, $maint) = split(/\s+/, $tmp, 4);
	    $pkg = "$pkg$srcext";
	    $Override{$distr, $major, $pkg, Priority} = $prio
		if ($prio    !~ /^\s*$/ && defined $prio   );
	    $Override{$distr, $major, $pkg, Section} = $section
		if ($section !~ /^\s*$/ && defined $section);
	    $Override{$distr, $major, $pkg, Maintainer} = $maint
		if ($maint   !~ /^\s*$/ && defined $maint  );
	    $Override{$distr, $major, $pkg} = 1;
	}
    }
}

###############################################################################
# Name:		relativePath
# Description:	Returns the relative path to another path.
# Arguments:	path to check for
#		path to give it against.
# Returns:	($pkgname, $version, $arch, $ext)
# Changelog:
#  2001-06-26 Ola Lundqvist <ola@inguza.com>
#	Written.
##############################################################################

sub relativePath ($$) {
    my ($p1, $p2) = @_;
    if ($p1 =~ /^\//) {
	return $p1;
    }
    elsif ($p1 =~ /^\~\//) {
	$p1 =~ s/^~\//$ENV{HOME}\//;
	return $p1;
    }
    $p2 =~ s/\/$//;
    return "$p2/$p1";
}

###############################################################################
# Name:		secondIfNotEmpty
# Description:	Returns the relative path to another path.
# Arguments:	two arguments
# Returns:	the second one if it is not empty, else the first one.
# Changelog:
#  2001-06-26 Ola Lundqvist <ola@inguza.com>
#	Written.
###############################################################################

sub secondIfNotEmpty ($$) {
    my ($p1, $p2) = @_;
    if (defined $p2 && $p2 !~ /^\s*$/) {
	return $p2;
    }
    return $p1;
}

__END__

###############################################################################
############################# DOCUMENTATION ###################################
###############################################################################

=head1 NAME

debarchiver - Tool to sort debian packages.

=head1 SYNOPSIS

debarchiver [options]

=head1 DESCRIPTION

The debian archiver is a tool that installs debian packages into a file structure suitable for apt-get, dselect and similar tools to use for updating the installed debian system. It is meant to be used by local administrators that needs special packages, or tweaked versions to ease administration.

The file structure is based on the potato file structure and does not support package pools. This may be implemented later, but is not high priority.

=head1 OPTIONS

=over 4

=item B<-a | --autoscan>

Does both --autoscanpackages and --autoscansources.

=item B<--autoscanall>

Same as --scanall --autoscan.

=item B<--autoscanpackages>

Automatically run dpkg-scanpackages after all new packages are installed.

=item B<--autoscansources>

Automatically run dpkg-scansources after all new packages are installed.

=item B<-b | --bzip>

Create bzip2 compressed Packages.bz2 and Sources.bz2 files. 

=item B<--cachedir> dir

The apt-ftparchive package cache directory, if --index is used.  Default $cachedir.

=item B<--cinstall> dir

Where the .changes file will be installed to, empty string to remove it instead, default $cinstall.

=item B<--configfile> file

Specify an extra configuration file to read. Will be read after etc config and user config file.

=item B<--copycmd>

The install command to use, default $copycmd. Both packages and .changes files are installed using this command.

=item B<-d | --dest | --destdir> dir

Destination directory. The base directory where all the distribution packages reside. Here the $distrib/$major/$arch/$section directory structure will be created. Default $destdir, relative to the input directory.

=item B<--debug-level | --dl> level

What information that should be printed. 1=critical, 2=error, 3=normal, 4=message, 5=debug, 6=verbose debug (modules).

=item B<--distinputcriteria>

The criteria for which binary packages that should be installed even if it does not have a .changes file, default $distinputcriteria.
 
=item B<--gpgkey>

GnuPG key to use to sign the archive.

=item B<--gpgpassfile>

File to provide password to GnuPG.

=item B<-i | --input | --indir | --inputdir> dir

This is the directory where the all packages and corresponding *.changes files that should be installed to the --dest directory, default $instdir.

=item B<--index | -x>

Automatically run apt-ftparchive after all new packages are installed.  config must be an absolute path to the configuration file to use for apt-ftparchive generate. See the apt-ftparchive manual page for more information. Use this *or* --autoscan, not both.

=item B<--instcmd>

DEPRECATED!

=item B<--help>

Prints this information.

=item B<--lockfile> file

The lockfile to use, default $lockfile.

=item B<--majordefault>

Default major section to use if undefined (default: main)

=item B<--movecmd>

Command to move files (currently not used at all).

=item B<--incompletetime>

The time to allow .changes file to be incomplete in seconds.
Defaults to 24 hours.

=item B<--mailfrom>

Specify mail sender.

=item B<--nosort>

Do not sort packages.

=item B<--nostructurefix>

Do not create directories and touch Package files.

=item B<-o | --addoverride>

Automatically add new packages to the override file.

=item B<--rmcmd>

The remove command to use, default $rmcmd. This can be used to move away the old packages to some other place.

=item B<--scanall>

Scan all distributions, sections, etc.

=item B<--scandetect | -s>

Scan using apt-ftparchive or dpkg-scan* depending on what is installed on the system. This is the recommended way. Only use --index or --autoscan if you know what you are doing.
 
=item B<--scanonly>

Same as --nosort --nostructurefix.

=item B<--quit-level> level

On what level to quit the application, see debug level.

=item B<-v | --version>

Prints the version string.

=item B<--ignoredestcheck>

Force install of changes files even if some files already exists with wrong size or md5 hash.

=head1 CONFIG FILE

You can also place config files with the following names (in following order) /etc/debarchiver.conf, ~/.debarchiver.conf and input.conf (relative to input directory) that will be read before, the arguments to this program will be parsed. Here you can change the following variables:

The configuration files are read as perl modules they should end with a true value. Therefore they should always end with 1;

=item B<$bzip>

If set to 0 no bzip2 files will be generated. If set to 1 bzip2 files will
be generated.

=item B<$incompletetime>

Time to allow .changes files to be incomplete in seconds. Useful for slow uploads.
Defaults to 24 hours.

=item B<$cachedir>

The cache directory for apt-ftparchive, used if --index is used.

=item B<$cinstall>

Where the .changes files are installed (see --cinstall above).

=item B<$copycmd>

The install command (see --copycmd).

=item B<$destdir>

The destination directory (see --destdir above).

=item B<$distinputcriteria>

The criteria for which packages that should be installed even if it does not have a .changes file, default $distinputcriteria.

=item B<%distinputdirs>

Directories (distribution => dir) to be searched for binary packages that do not need a .changes file to be installed but match $distinputcriteria.  The default is kernel packages generated by make-kpkg which does not generate a .changes file.  Additionally binary packages with a valid .changes file will have the default distribution overridden to be the current queue directory.  This causes uploads to a specific queue to place the package into that distribution directly.

=item B<$gpgkey>

GnuPG key to use to sign the archive.  If this variable is set, the Release file for each changed section of the archive will be signed with GnuPG using $gpgkey as the key ID.  Unless you use a key that has no passphrase or use $gpgpassfile, you will need to run B<debarchiver> interactively when using this option so that you can supply the passphrase.

=item B<$gpgpassfile>

A file that contain the passphrase for the GnuPG key. See $gpgkey for more
information.

=item B<$inputdir>

The input directory (no effect in $inputconfigfile).

=item B<$lockfile>

The lockfile to use, default $lockfile.

=item B<@mailtos>

An array of strings that should be mailed to. If the string contains an email address that one is used. If it contains an incomplete email address, i.e. @hostname, the username owning the file is used @ the hostname specified. If no @ character is found in the string, it is considered as a field in the .changes file. Such a field can for example be Maintainer or Uploaders.

=item B<$mailfrom>

Specify the sender of emails.
Default to none ("")

=item B<$majordefault>

Default major section (see --majordefault above).

=item B<$movecmd>

The move command (see --movecmd).

=item B<%release>

Additional information to add to generated Release files.  Supported keys are origin, label, and description.

=item B<$rmcmd>

The remove command (see --rmcmd above).

=item B<$verifysignatures>

Choose to enable (1) or disable (0) signature verification for packages uploaded into $inputdir (not %distinputdirs).

=item B<$ignoredestcheck>

Force install of changes files even if some files already exists with wrong size or md5 hash. Default to 0.

=item B<$verifysignaturesdistinput>

Choose to enable (1) or disable (2) signature verification for packages uploaded into %distinputdirs. This works independently from $verifysignatures.

=back

=head1 PACKAGE INDEXING

There are two ways to generate the indexes that B<apt-get> relies on.

Using B<--autoscanpackages>, B<--autoscansources>, or B<--autoscan> will use B<dpkg-scanpackages> and B<dpkg-scansources>.  This will generate the Packages and Sources files, but will not generate Contents files and can be slow with a large repository.

Alternatively, the B<--index> I<config> option will call B<apt-ftparchive> to index the package tree.  B<apt-ftparchive> can also generate Contents files (for use with B<apt-file>), and can optionally use a cache of package information to speed up multiple runs.  The B<apt-ftparchive> configuration file will be generated automatically. This is however not fully tested.

You should use either B<--autoscanpackages> and B<--autoscansources> or B<--index>, not both, as they both do basically the same thing.

The default action (and the recommended) is B<--scandetect> that probe for installed software and use the best choice depending on what software you have installed (choose between --index and --autoscan right now).

=head1 REJECT

Changes files are rejected in the following conditions:
 * If a file that is about to be installed, already exist in the archive and is not identical to the one that is about to be installed.
 * Changes file is incomplete and has been there for $incompletetime time.
 * A file that is part of the Changes file is not yet big enough and the changes file has been there for $incompletetime time.
 * A file that is part of the Changes file is bigger than specified.
 * If verify signatures is enabled and signature do not match.

=head1 FILES

B</etc/debarchiver.conf>

=head1 SEE ALSO

B<apt-ftparchive>(1)

=head1 AUTHOR

Ola Lundqvist <ola@inguza.com>

=cut
