#!/usr/bin/perl
# DocumentId:	$Id: debarchiver.pl 1978 2005-01-10 20:53:29Z ola $
# Author:	$Author: ola $
# Date:		$Date: 2005-01-10 21:53:29 +0100 (mån, 10 jan 2005) $
# Version:	$Revision: 1.49 $
# Summary:
#	This program reads a config file, traverse through all .changes files
#	in the specified directory and puts the files into the right place.
#

###############################################################################
############################# USES ############################################
###############################################################################

use File::Path qw(mkpath);
#use File::Copy qw(copy move);
use OpaL::action qw(pdebug action cmdaction
		    setDebugLevel
		    setQuitLevel
		    setErrorHandler);
use OpaL::read qw(readfile readcommand);

###############################################################################
########################### CONSTANTS #########################################
###############################################################################

$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;
$userconfigfile = "$ENV{HOME}/.debarchiver.conf";

###############################################################################
########################## DECLARATION ########################################
###############################################################################

# 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 = "^kernel.*\\.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 => 'sarge',
		testing => 'etch',
		unstable => 'sid'
	       );

@architectures = ('i386');

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

@mailtos = ();

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

$sortpackages = 1;
$fixstructure = 1;

###############################################################################
############################ CONFIG ###########################################
###############################################################################

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

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

###############################################################################
############################# ARGS ############################################
###############################################################################

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 (/^-i$/ || /^--input$/ || /^--indir$/ || /^--inputdir$/) {
      $inputdir = shift @ARGS1;
      $inputdir =~ s/\/$//;
    }
    else {
      push @ARGS2, $_;
    }
  }
  else {
    push @ARGS2, $_;
  }
}

###############################################################################
######################### INPUT CONFIG ########################################
###############################################################################

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

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

###############################################################################
############################# HELP ############################################
###############################################################################

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

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

options:
 --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).
 --quit-level level	On what level to quit the application, see debug level.
 -v | --version		Prints the version string.
 --help			Prints this information.
 --copycmd		The install command to use, default $copycmd.
			 Both packages and .changes files are installed using
			 this command.
 --movecmd		Command to move files (currently not used at all).
 --mailcmd		The mail command to use, default $mail.
 --rmcmd		The remove command to use, default $rmcmd.
			 This can be used to move away the old packages to
			 some other place.
 --instcmd		DEPRICATED!
 -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.
 --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.
 --index | -x           Automatically run apt-ftparchive after all new packages
                         are installed.  Use this *or* --autoscan, not both.
 -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.
 --cachedir dir         The apt-ftparchive package cache directory, if --index
                         is used.  Default $cachedir.
 --lockfile file	The lockfile to use, default $lockfile.
 --cinstall dir		Where the .changes file will be installed to,
			 empty string to remove it instead, default $cinstall.
 --distinputcriteria     The criteria for which binary packages that should be
			 installed even if it does not have a .changes file,
			 default $distinputcriteria.
 -o | --addoverride    	Automaticly add new packages to the override file.
 --autoscanpackages	Automaticly run dpkg-scanpackages after all new
			 packages are installed.
 --autoscansources	Automaticly run dpkg-scansources after all new
			 packages are installed.
 -a | --autoscan       	Does both --autoscanpackages and --autoscansources.
                         Use this *or* --index, not both.
 --scanall		Scan all distributions, sections, etc.
 --autoscanall		Same as --scanall --autoscan.
 --nosort		Do not sort packages.
 --nostructurefix	Do not create directories and touch Package files.
 --scanonly		Same as --nosort --nostructurefix.

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
	\$destdir      	The destination directory (see --destdir above).
	\$inputdir	The input directory (no effect in $inputconfigfile).
        \$cachedir	The cache directory for apt-ftparchive, used if
			--index is used.
	\$copycmd	The install command (see --copycmd).
	\$movecmd	The move command (see --movecmd).
	\$rmcmd		The remove command (see --rmcmd above).
	\$cinstall	Where the .changes files are installed
			 (see --cinstall 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 bianry packages that does not need
			a .changes file to be installed.
	\$lockfile	The lockfile to use, default $lockfile.
	\@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.
        \%release	Additional information to add to generated Release
			files.  Supported keys are origin, label, and
			description.
";

###############################################################################
############################# ARGS ############################################
###############################################################################

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 (/^--rmcmd$/) {
      $rmcmd = shift @ARGS2;
    }
    elsif (/^-d$/ || /^--destdir$/ || /^--dest$/) {
      $destdir = shift @ARGS2;
      $destdir =~ s/\/$//;
    }
    elsif (/^--cachedir$/) {
      $cachedir = shift @ARGS2;
    }
    elsif (/^--lockfile$/) {
      $lockfile = shift @ARGS2;
    }
    elsif (/^--cinstall$/) {
      $cinstall = shift @ARGS2;
      $cinstall =~ s/\/$//;
    }
    elsif (/^-o$/ || /^--addoverride$/) {
      $addoverride = 1;
    }
    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 (/^--distinputcriteria/) {
      $distinputcriteria = shift @ARGS2;
    }
    elsif (/^--scanall$/) {
      $scanall = 1;
    }
    elsif (/^--autoscanall$/) {
      $scanall = 1;
      $autoscanpackages = 1;
      $autoscansources = 1;
    }
    elsif (/^--scanonly$/) {
      undef $sortpackages;
      undef $fixstructure;
    }
    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.
###############################################################################

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

handleStructureFix();

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

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

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

action(! chdir $inputdir, "Change to dir $inputdir", 2);
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.
# Dates:	2001-07-14	Written.
# Arguments:	directory, filename
###############################################################################

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.
# Dates:	2004-08-09	Written.
#               2004-08-10      Renamed $release to $contents.
#                               Don't generate if any under a symlink.
# Arguments:	directory, distribution, section, architecture
# Uses:         %release
###############################################################################

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.
# Changelog:
#	2003-02-12	Ola Lundqvist <opal@debian.org>
#		Wrote it.
#	2003-02-13	Ola Lundqvist <opal@debian.org>
#		Extended it with @hostname calculation.
#	2003-02-28 Ola Lundqvist <opal@debian.org>
#		Added debugging information.
#	2003-03-14 Ola Lundqvist <opal@debian.org>
#		Switched to using CMeta for ChangeLog meta information.
#	2003-06-10 Ola Lundqvist <opal@debian.org>
#		Switched from direct determination of changes owner to use
#		precalculated data from CMeta{FileOwner}.
# Uses:		CConf, CMeta hash.
###############################################################################

sub determineMailTo() {
    my $to = "";
    my $toi;
    foreach $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*$/) {
	    if ($to =~ /^\s*$/) {
		$to = $toi;
	    }
	    else {
		$to = "$to, $toi";
	    }
	}
    }
    pdebug(5, "Mail will be sent to $to.");
    return $to;
}

###############################################################################
# Name:		email
# Description:	Send an email to persons, for package with message.
# Changelog:
#	2002-09-11 Ola Lundqvist <opal@debian.org>
#		Stub written.
#	2003-02-12 Ola Lundqvist <opal@debian.org>
#		Writen the mail sending function.
#	2003-02-28 Ola Lundqvist <opal@debian.org>
#		Added debugging information and fixed arg handling.
#	2003-03-13 Ola Lundqvist <opal@debian.org>
#		Debugged the mail command. It stalls.
# Arguments:	to, package, key, message
###############################################################################
sub email($$$$) {
    my ($to, $package, $key, $message) = @_;
    if (length($to) > 0) {
	pdebug(5, "Executing mail command, $mailcmd -s '$package $key' $to.");
	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.
# Dates:
#	2002-09-11	Ola Lundqvist <opal@debian.org>
#		Written.
#	2003-02-12	Ola Lundqvist <opal@debian.org>
#		Uses CConf instead of cfile argument.
#	2003-03-14 Ola Lundqvist <opal@debian.org>
#		Switched to using CMeta for ChangeLog meta information.
# Uses:		%CMeta and maybe %Cfiles in the future.
###############################################################################
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
# Dates:
#	2002-09-12	Ola Lundqvist <opal@debian.org>
#		Written using data from mailSuccess.
#	2003-02-12	Ola Lundqvist <opal@debian.org>
#		Uses CConf instead of cfile argument.
#	2003-03-14 Ola Lundqvist <opal@debian.org>
#		Switched to using CMeta for ChangeLog meta information.
# Uses:		%CMeta and maybe %Cfiles in the future.
###############################################################################
sub mailReject() {
    # OOPS! We can not read that file after it has been moved!
    my $message = $CMeta{ChangesContent};
    if (length($CConf{ERROR}) > 0) {
	$message += "\n$CConf{ERROR}";
    }
    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.
# Dates:	2001-07-23	Written.
# Changes:	%dests
# Uses:		@distributions, @sections, @architectures, $destdir.
###############################################################################

sub handleScanAll() {
  my ($d, $s, $a);
  foreach $d (@distributions) {
    foreach $s (@sections) {
      if (-e "$destdir/$d/$s/override") {
	foreach $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.
# Dates:	2001-06-26	Written.
#		2001-07-23	Added lockfile check to distr directory.
#				Improved documentation.
#		2002-01-22	Moved lock file checking to its own function.
#		2003-02-12	Now redirects stderr to stdout for
#				dpkg-scan* so that it can be logged.
# Uses:		%dests, $destdir,
#		$autoscanpackages, $autoscansources.
# Changes:	$ENV{PWD}
###############################################################################

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);
      }
      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" && ! -f "$over/$d/Packages.gen") {
#              cmdaction("mv $over/$d/Packages $over/$d/Packages.gen",
#                        "Move packges file to packages.gen file.",
#                        3);
#            }
	      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);
	    }
	  }
	  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);
	}
      }
    }

    &destinationRelease();
  }
}

###############################################################################
# Name:		findSectionsArchitectures
# Description:	Find sections and architectures in a distribution.
# Dates:	2004-08-10      Written.
# Arguments:    Path to distribution directory to check,
#               reference to section array to fill out,
#               reference to architectures array to fill out
###############################################################################

sub findSectionsArchitectures($\@\@) {
  my ($dir, $sectionlist, $archlist) = @_;
  my (%dirsections, %dirarches);
  foreach $s (@sections) {
    if (-e "$dir/$s/override") {
      foreach $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.
# Dates:	2004-08-10      Written.
# Uses:		%dests, $destdir, $cachedir
# Returns:      Path to the generated config file
###############################################################################

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 "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 $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:		handleIndex
# Description:	Handles the indexing via apt-ftparchive.
# Dates:	2004-07-30	Written.
#               2004-08-09      Add merging of binary-all Packages file.
# Uses:		%dests, $destdir
# Changes:	$ENV{PWD}
###############################################################################

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 $d (keys %changedist) {
    my (@dsections, @darches);
    &findSectionsArchitectures("$destdir/$d", \@dsections, \@darches);
    foreach $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",
                    3);
        }
      }
      unlink("$d/$s/binary-all/Packages", "$d/$s/binary-all/Packages.gz");
    }
  }

  &destinationRelease();
}

###############################################################################
# Name:		handleSorting
# Description:	Sort packages into the right place.
# Dates:	2001-07-23	Moved from START section to this subprocedure.
# Uses:		A lot.
###############################################################################

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

    # Read the content of this directory.
    opendir(D, ".");

    my $found = 1;

    while ($found) {
      # go through all .changes files:
      $found = 0;
      while($cfile = readdir(D)) {
	# Only .changes files.
	if ($cfile =~ /\.changes$/) {
	  handleChangesFile($cfile);
	  $found = 1;
	}
      }
    }

    closedir(D);

    my $kdir;
    foreach $kdir (keys %distinputdirs) {
      $distinputdirs{$kdir} =~ s/\n$//;
      if (-d $distinputdirs{$kdir}) {
	opendir(D, $distinputdirs{$kdir});
	my $kfile;
	while ($kfile = readdir(D)) {
	  if ($kfile =~ /$distinputcriteria/) {
	    handleDebOnlyFile("$distinputdirs{$kdir}/$kfile", $kdir);
	  }
	}
      }
    }

    &incomingRelease();
  }
}

###############################################################################
# Name:		handleStructureFix
# Description:	Fix the distribution directory structure.
# Dates:	2001-07-23	Moved from START section to this subprocedure.
#               2004-08-09      Call createRelease to build Release files.
# Uses:		@distributions, @sections, @architectures, $fixstructure
###############################################################################

sub handleStructureFix() {
  if (defined $fixstructure) {
    my ($di, $se, $ar);
    for $di (@distributions) {
      my $dis = $distmapping{$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.
# Dates:	2001-06-29	Written.
# Arguments:	A deb file.
#		The distribution to install to.
# Changes:	see parseKernelFile
###############################################################################

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

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


###############################################################################
# Name:		handleChangesFile
# Description:	Handles the .changes file.
# Changes:
# 2001-06-26 Ola Lundqvist <opal@debian.org>
#	Taken from the main script. Cut and paste with simple changes.
# 2003-03-13 Ola Lundqvist <opal@debian.org>
#	Added mailSuccess command thing.
# 2003-06-10 Ola Lundqvist <opal@debian.org>
#	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.
# Uses:		parseChanges, pdebug, $copycmd, $rmcmd, uploaderIsChangesFileOwner
# Changes:	See parseChanges.
# Arguments:	The .changes file.
# Returns:	nothing
###############################################################################

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

  parseChanges($cfile);
  uploaderIsChangesFileOwner($cfile);
  if ($verifysignatures) {
    if (system($vrfycmd,$cfile)) { # non-zero == verification failure
      rejectChangesFile();
      pdebug(2, "Signature verification failed for $cfile");
      return;
    }
  }

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

###############################################################################
# Name:		uploaderIsChangesFileOwner
# Description:	Sets CMeta{FileOwner} from 
# Changes:	CMeta
# Dates:
#	2003-06-10	Ola Lundqvist <opal@debian.org
#		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
# Dates:
#	2003-02-12	Ola Lundqvist <opal@debian.org
#		Wrote it.
#	2003-02-28	Ola Lundqvist <opal@debian.org
#		Implemented the commands in the foreach loop.
#	2003-03-14 Ola Lundqvist <opal@debian.org>
#		Switched to using CMeta for ChangeLog meta information.
###############################################################################

sub rejectChangesFile() {
    my $file;
    if (! -d "REJECT") {
	action(! mkpath ("REJECT", 0, 0775),
	       "Making REJECT directory.",
	       2);
    }
    if ($CMeta{ChangesFile} != "") {
	cmdaction("$mvcmd $CMeta{ChangesFile} REJECT/",
		  "Move .changes to REJECT dir.",
		  2);
    }
    foreach $file (keys %CFiles) {
	if (-f $file) {
	    cmdaction ("$mvcmd $file REJECT/",
		       "Move $file to REJECT dir.",
		       3);
	}
	else {
	    $CConf{ERROR} = "$CConf{ERROR}File $file can not be moved because it is already installed.\n";
	}
    }
}

###############################################################################
# Name:		handlePackageFile
# Description:	Handles the package file.
# Dates:	2001-06-26	Taken from the main script. Cut and paste with
#				simple changes.
# Uses:		Same as parseChanges produces.
# Changes:	%dests
# Arguments:	The package file (the key in CFiles).
# Returns:	nothing
###############################################################################

sub handlePackageFile ($) {
  my ($file, $action) = @_;
  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

  my $distr;
  foreach $distr (split /\s+/, $distrd) {
    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);
    }
    else {
      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);
  }
  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.
# Changes:
#	2001-06-10 Ola Lundqvist <opal@debian.org>
#		Wrote it.
#	2003-03-14 Ola Lundqvist <opal@debian.org>
#		Now CConf{ChangesFile} is changed when copying 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).
###############################################################################

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

  my $distrd = $CConf{Distribution};
  my $distr;
  foreach $distr (split /\s+/, $distrd) {
    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 #######################################
###############################################################################

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

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

sub incomingError() {
    &setErrorHandler(undef);
    &removeLockfile("$lockfile");    
    &setErrorHandler(\&rejectError);    
    &rejectChangesFile();
}

sub rejectError() {
    &setErrorHandler(undef);
    &mailReject();
}

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.
# Dates:	2002-01-22	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.
# Dates:	2002-01-22	Written.
# Arguments:	none
# Needs:	$rmcmd $lockfile
# Returns:	nothing
###############################################################################

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

###############################################################################
# Name:		removeLockfile
# Description:	Removes the lockfile.
# Dates:	2002-01-22	Written.
# Arguments:    $lockfile
# Returns:	nothing
###############################################################################

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.
# Dates:	2001-06-10	Written.
# 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).
###############################################################################

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

###############################################################################
# Name:		parseFileStruct
# Description:	Parses a hash size section prio string.
#		It is a simple split...
# Dates:	2001-06-10	Written.
# Arguments:	The string.
# Returns:	($hash, $size, $section, $prio)
###############################################################################

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

###############################################################################
# Name:		parseFileName
# Description:	Parses a file name and splits into $pkgname, $version, $arch
# Dates:	2001-06-10	Written.
# Arguments:	deb filename.
# Returns:	($pkgname, $version, $arch, $ext)
###############################################################################

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 parseChanges does.
# Dates:
#	2001-06-29 Ola Lundqvist <opal@debian.org>
#		Written with info from parseChanges.
#	2003-02-12 Ola Lundqvist <opal@debian.org>
#		Added ChangesFile to CConf hash.
# Arguments:	A deb file name.
# Changes:	see parseChanges
###############################################################################

sub parseDebOnlyFile($$) {
  my ($kfile, $distr) = @_;
  my $state = "";
  my $line;
  my $section;
  my $priority;
  my $size;
  my $desc;
  %CConf = (Distribution => $distr);
  %CMeta = (ChangesFile => "", ChangesContent => "");
  %CFiles = ();
  %CDesc = ();
  my @cmdres = readcommand("dpkg-deb -f $kfile");
  foreach $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:		parseChanges
# Description:	Parses a debian changelog file and extracs the information.
# ChangeLog:
#	2001-06-10 Ola Lundqvist <opal@debian.org>
#		Written.
#	2001-06-26 Ola Lundqvist <opal@debian.org>
#		Changed print to pdebug.
#	2002-09-11 Ola Lundqvist <opal@debian.org>
#		Added uploaders field to the description.
#	2003-02-12 Ola Lundqvist <opal@debian.org>
#		Added ChangesFile to CConf hash.
#	2003-03-14 Ola Lundqvist <opal@debian.org>
#		Switched to using CMeta for ChangeLog meta 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."
###############################################################################

sub parseChanges($) {
  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/) {
      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.
# Dates:	2001-06-26	Written.
# 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.
###############################################################################

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");
    my $tmp;
    $Override{$distr,$major, $def} = 1;
    foreach $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.
# Dates:	2001-06-26	Written.
# Arguments:	path to check for
#		path to give it against.
# Returns:	($pkgname, $version, $arch, $ext)
###############################################################################

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.
# Dates:	2001-06-26	Written.
# Arguments:	two arguments
# Returns:	the second one if it is not empty, else the first one.
###############################################################################

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<--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<--quit-level> level

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

=item B<-v | --version>

Prints the version string.

=item B<--help>

Prints this information.

=item B<--copycmd>

The install command to use, default $copycmd. Both packages and .changes files are installed using this command.
 
=item B<--movecmd>

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

=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<--instcmd>

DEPRECATED!

=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<--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<-x | --index>

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<-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<--cachedir> dir

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

=item B<--lockfile> file

The lockfile to use, default $lockfile.

=item B<--cinstall> dir

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

=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<-o | --addoverride>

Automatically add new packages to the override file.

=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<-a | --autoscan>

Does both --autoscanpackages and --autoscansources.

=item B<--scanall>

Scan all distributions, sections, etc.

=item B<--autoscanall>

Same as --scanall --autoscan.

=item B<--nosort>

Do not sort packages.

=item B<--nostructurefix>

Do not create directories and touch Package files.

=item B<--scanonly>

Same as --nosort --nostructurefix.

=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:

=item B<$destdir>

The destination directory (see --destdir above).

=item B<$inputdir>

The input directory (no effect in $inputconfigfile).

=item B<$cachedir>

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

=item B<$copycmd>

The install command (see --copycmd).

=item B<$movecmd>

The move command (see --movecmd).

=item B<$rmcmd>

The remove command (see --rmcmd above).

=item B<$cinstall>

Where the .changes files are installed (see --cinstall 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>

The directories (distribution => dir) that should be searched for extra bianry packages that does not need a .changes file to be installed.

=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<%release>

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

=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 FILES

B</etc/debarchiver.conf>

=head1 SEE ALSO

B<apt-ftparchive>(1)

=head1 AUTHOR

Ola Lundqvist <opal@debian.org>

=cut
