#!/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-2011 Ola Lundqvist # Copyright (C) 2011 Helge Kreutzmann # Copyright (C) 2010 Mats Erik Andersson # Copyright (C) 2009 Franck Joncourt # Copyright (C) 2004,2008 Michael Rash # Copyright (C) 2007 Turbo Fredriksson # Copyright (C) 2004-2005 Russ Allbery # Copyright (C) 2005 Joel Baker # Copyright (C) 2005 Daniel Leidert # Copyright (C) 2005 Bob Proulx # Copyright (C) 2005-2006 Valéry Perrin # Copyright (C) 2006 Yaroslav Halchenko # Copyright (C) 2006 Jérémy Bobbio # Copyright (C) 2006 Michael Hanke # Copyright (C) 2006 Martin F Krafft # Copyright (C) 2006 Håkon Stordahl # # 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. # ############################################################################### ############################ REQUIRE ########################################## ############################################################################### # Require autoloader require AutoLoader; *AUTOLOAD = \&AutoLoader::AUTOLOAD; ############################################################################### ############################# USES ############################################ ############################################################################### use File::Spec; 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 # Written # 2005-05-01 Ola Lundqvist # Bug fix for bzip2 support. # 2005-05-06 Daniel Leidert # Add setting to enable/disable signature checking in distinput-dirs. # 2005-09-09 Ola Lundqvist # Support for gpg password file. # 2005-09-15 Daniel Leidert # Fix regarding $gpgpassfile. # 2005-10-08 Ola Lundqvist # 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 # Removed fix regarding $gpgpassfile (moved to checks below). # 2005-10-12 Daniel Leidert # Fix signcmd default. # 2005-10-14 Daniel Leidert # Remove signcmd variable. # 2007-10-09 Turbo Fredriksson # Allow forcing an install of an upload (i.e., ignore existing files in # destdir). # 2007-10-09 Ola Lundqvist # Changed force option to ignoredestcheck option. # 2009-03-16 Franck Joncourt # Added usermailcmd, mailsearch, usermailcmd and cmds. Removed mailcmd. $mailformat = ""; @mailsearch = (); $usermailcmd = ''; %cmds = (); $cmds{'sendmail'} = "sendmail"; $cmds{'mail'} = "mail"; $copycmd = "cp -af"; $rmcmd = "rm -f"; $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 # Written # 2007-10-08 Ola Lundqvist # Updated with new options. # 2007-10-09 Ola Lundqvist # 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 # Written # 2005-10-08 Ola Lundqvist # Added the possibility to specify a config file on command line. # Inspired by a patch from Alexander Wirt . 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 # Written # 2005-10-08 Ola Lundqvist # Added the possibility to specify a config file on command line. # Inspired by a patch from Alexander Wirt . # 2007-08-14 Ola Lundqvist # 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 # Written # 2007-08-14 Ola Lundqvist # 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 # Written if ($gpgpassfile) { $gpgpassfile = "" if (! -f $gpgpassfile); } else { $gpgpassfile = ""; } ############################################################################### ############################# HELP ############################################ ############################################################################### # Changelog: # 2000-2004 Ola Lundqvist # Written # 2005-09-09 Ola Lundqvist # Added information about gpg support. # 2005-10-08 Ola Lundqvist # Added the possibility to specify a config file on command line. # Inspired by a patch from Alexander Wirt . # 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 # Removed signcmd. # 2006-02-25 Yaroslav Halchenko and # Ola Lundqvist # Default major section function. # 2006-11-28 Ola Lundqvist # Sorted options in alphabetical order. # 2007-10-08 Ola Lundqvist # Make it possible to specify mail sender. # 2007-10-09 Turbo Fredriksson # Allow forcing an install of an upload (i.e., ignore existing files in # destdir). # 2007-10-09 Ola Lundqvist # Changed force option to ignoredestcheck option. # 2009-03-16 Franck Joncourt # Modified mailcmd and added mailformat option. # 2009-03-16 Ola Lundqvist # Changed to version 0.9. # 2011-11-02 Ola Lundqvist # Improved english lanauge. $version = "0.9"; $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 to use if --index is used. Default \"/var/cache/debarchiver\". --cinstall dir - Where the .changes file will be installed to. Use the empty string to remove the .changes file instead. The default is \"installed\". --configfile file - Specifies an extra configuration file to read. Will be read after etc configuration and after user configuration files. --copycmd - The install command to use where the default is \"cp -af\". 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 will reside and where the \$distrib/\$major/\$arch/\$section directory structure will be created. The default is /var/lib/debarchiver/dists. --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 what binary packages should be installed even they do not have a .changes file. The default criteria is \"^linux.*\\.deb\$\". --gpgkey - The GnuPG key to use to sign the archive. --gpgpassfile - The file that provides the password to GnuPG. --help - Prints this information. -i | --input dir - This is the directory where debarchiver will look for --indir dir new package versions and corresponding *.changes files that --inputdir dir should be installed to the --dest directory. The default directory is /var/lib/debarchiver/incoming. --ignoredestcheck - Force install of .changes file even if some files specified in the .changes file already exists with wrong size or md5 hash. --index | -x - Automatically run apt-ftparchive after all new packages are installed. Use this *or* --autoscan, not both. --incompletetime - The time to allow .changes file to be incomplete in seconds. The default is 24 hours. --instcmd - DEPRICATED! --lockfile file - The lockfile to use. The default is \"debarchiver.lock\". --mailcmd - The mail command to use. The default is to use the \"sendmail\" command. --mailformat format - Defines the format to be used to send emails. It should correspond to the format used by the command specified by --mailfrom. Only 'sendmail' and 'mail' formats are supported. By default debarchiver assumes 'sendmail' format. The format argument can be one of the following: sendmail = use of the sendmail format mail = use of the mail format --mailfrom - Specifies mail sender. --majordefault section - The default major section to use. The default is 'main'. --movecmd - Command used 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. --quit-level level - On what level to quit the application. See debug level for further information. --rmcmd - The remove command to use. The default is \"rm -f\". This can be used to move away the old packages to some other place. --scanall - Scan all distributions, sections, etc. --scandetect | -s - Scan using 'apt-ftparchive' or 'dpkg-scan*' (dpkg-scanpackages and dpkg-scansources) 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. You can also place configuration files with the following names (in the following order) /etc/debarchiver.conf, ~/.debarchiver.conf and input.conf (relative to input dir), that will be read before the arguments to this program will be parsed. In the above files you can change the following variables: \$bzip2 - If set to 0 no bzip2 files will be generated. If set to 1 bzip2 files will be generated. \$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. The default is \"^linux.*\\.deb\$\". \%distinputdirs - The directories (distribution => dir) that should be searched for extra binary packages that does not need a .changes file to be installed but match \$distinputcriteria. \$gpgkey - The GnuPG key to use to sign the archive. \$gpgpassfile - The file that will provide the password to GnuPG. \$inputdir - The input directory (no effect in \"input.conf\"). \$ignoredestcheck - Force install of .changes file even if some files specified in the .changes file already exists with wrong size or md5 hash. The default is 0 (do not ignore). \$incompletetime - The time to allow .changes file to be incomplete in seconds. The default is 24 hours. \$lockfile - The lockfile to use. The default is \"debarchiver.lock\". \$mailformat - The format to use to send emails (see --mailformat above). \$mailfrom - Specify the mail sender. \@mailtos - The fields in .changes file that should be used for mailing SUCCESS and REJECT messages. If there is an @ char in the array that address will be used directly. \$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). \$usermailcmd - It allows the user to tell debarchiver to use a specific command to send emails. You may also want to specify the mailformat your mail command handles by setting the value of the \$mailformat variable. Using the --mailcmd option on the command line will superseed this variable. "; ############################################################################### ############################# ARGS ############################################ ############################################################################### # Changelog: # 2000-2004 Ola Lundqvist # Written # 2005-05-01 Daniel Leidert # Added bzip2 support. # 2005-09-09 Ola Lundqvist # Added options for gpg signing support. # 2006-02-25 Yaroslav Halchenko and # Ola Lundqvist # Default major section function. # 2007-10-09 Turbo Fredriksson # Allow forcing an install of an upload (i.e., ignore existing files in # destdir). # 2007-10-09 Ola Lundqvist # 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$/) { $usermailcmd = shift @ARGS2; } elsif (/^--mailformat$/) { $mailformat = 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"); } } &check_mailconfig(); &check_commands({}, {}); ############################################################################### ############################# 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 # 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 # Written. # 2004-08-10 Ola Lundqvist # 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 = ; 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 # Wrote it. # 2003-02-13 Ola Lundqvist # Extended it with @hostname calculation. # 2003-02-28 Ola Lundqvist # Added debugging information. # 2003-03-14 Ola Lundqvist # Switched to using CMeta for ChangeLog meta information. # 2003-06-10 Ola Lundqvist # Switched from direct determination of changes owner to use # precalculated data from CMeta{FileOwner}. # 2007-10-09 Turbo Fredriksson # Change in foreach to use my variable. # 2010-04-17 Mats Erik Andersson # Correction of debug for sendlist. # 2010-04-22 Ola Lundqvist # Extended the suggestion from Mats to make sure the list is properly # ordered. ############################################################################### 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*$/) { if (! defined $to_hash{$toi}) { if ($to eq "") { $to = $toi; } else { $to = $to . ", " . $toi; } $to_hash{$toi} = 1; } } } chomp $to; pdebug(5, "Mail will be sent to $to."); return $to; } ############################################################################### # Name: email # Description: Send an email to persons, for package with message. # Arguments: to, package, key, message # Changelog: # 2002-09-11 Ola Lundqvist # Stub written. # 2003-02-12 Ola Lundqvist # Writen the mail sending function. # 2003-02-28 Ola Lundqvist # Added debugging information and fixed arg handling. # 2003-03-13 Ola Lundqvist # Debugged the mail command. It stalls. # 2007-10-08 Ola Lundqvist # Make it possible to specify mail sender. # 2009-03-16 Franck Joncourt # Added support for sendmail in addition to mail command format. ############################################################################### sub email($$$) { my ($toAddress, $subject, $msg) = @_; pdebug(5, "Sending mail ..."); if ( $use_sendmail && ($mailfrom eq "") ) { pdebug(5, "No sender mail address found, use of the debarchiver user instead."); } my $err=1; if ($toAddress eq "") { pdebug(3, "No recipient to send mail to."); } elsif ($subject eq "") { pdebug(3, "Empty subject"); } elsif ($msg eq "") { pdebug(3, "Empty message") } else { $err = 0; } if ($err) { pdebug(2, "No mail sent due to missing parameters"); } elsif (defined $cmds{'sendmail'}) { pdebug(4, "Use of the sendmail command: $cmds{'sendmail'}"); if (open(M, "| $cmds{'sendmail'} -t")) { print M "From: $mailfrom\n" unless ($mailfrom eq ""); print M "To: $toAddress\n", "Subject: $subject\n\n", $msg . "\n"; close(M); } else { pdebug(2, "Could not execute $cmds{'sendmail'} $!"); } } else { pdebug(4, "Use of the mail command: $cmds{'mail'}"); if (open(M, "| $cmds{'mail'} -s '$subject' '$toAddress'")) { print M $msg . "\n"; close(M); } else { pdebug(2, "Could not execute $cmds{'mail'} $!"); } } pdebug(5, "Mail exec done."); } ############################################################################### # Name: mailSuccess # including the .gz file. # Uses: %CMeta and maybe %Cfiles in the future. # Changelog: # 2002-09-11 Ola Lundqvist # Written. # 2003-02-12 Ola Lundqvist # Uses CConf instead of cfile argument. # 2003-03-14 Ola Lundqvist # Switched to using CMeta for ChangeLog meta information. # 2009-03-16 Franck Joncourt # Small modification. ############################################################################### sub mailSuccess() { # OOPS! We can not read that file after it has been moved! my $message = $CMeta{ChangesContent}; my $subject = "$CConf{'Source'} ACCEPTED"; my $recipient = determineMailTo(); pdebug(5, "Mail Success."); email($recipient, $subject, $message); } ############################################################################### # Name: mailReject # Uses: %CMeta and maybe %Cfiles in the future. # Changelog: # 2002-09-12 Ola Lundqvist # Written using data from mailSuccess. # 2003-02-12 Ola Lundqvist # Uses CConf instead of cfile argument. # 2003-03-14 Ola Lundqvist # Switched to using CMeta for ChangeLog meta information. # 2007-10-08 Turbo Fredriksson # Error string in beginning and full message (+= => .=). # 2009-03-16 Franck Joncourt # Small modification. ############################################################################### 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}; my $subject = "$CConf{'Source'} REJECTED"; my $recipient = determineMailTo(); pdebug(5, "Mail Reject."); email($recipient, $subject, $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 # Written. # 2007-10-09 Turbo Fredriksson # 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 # Written. # 2001-07-23 Ola Lundqvist # Added lockfile check to distr directory. # Improved documentation. # 2002-01-22 Ola Lundqvist # Moved lock file checking to its own function. # 2003-02-12 Ola Lundqvist # Now redirects stderr to stdout for # dpkg-scan* so that it can be logged. # 2005-05-01 Daniel Leidert # Modified to add bzip2 support. # 2005-05-02 Ola Lundqvist # 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", "Gzip $archdest/Sources", 3); if ($bzip) { cmdaction("bzip2 $archdest/Sources -c > $archdest/Sources.bz2", "BZip $archdest/Sources", 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", "Gzip $over/$d/Packages", 3); if ($bzip) { cmdaction("bzip2 $over/$d/Packages -c > $over/$d/Packages.bz2", "BZip $over/$d/Packages", 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", "Gzip $archdest/Packages", 3); if ($bzip) { cmdaction("bzip2 $archdest/Packages -c > $archdest/Packages.bz2", "BZip $archdest/Packages", 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 # Written. # 2007-10-09 Turbo Fredriksson # 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 # Written. # 2005-05-01 Daniel Leidert # Modified to add bzip2 support. # 2005-05-02 Ola Lundqvist # Bugfix for bzip2 support. # 2007-10-09 Turbo Fredriksson # 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 # Written. # 2005-09-02 Joergen Haegg # Unlink Relase.gpg before creation. # 2005-09-09 Ola Lundqvist # Made it possible for gnupg to read passphrase from file. # 2005-09-15 Daniel Leidert # Fix regarding $gpgpassfile. # 2005-10-08 Ola Lundqvist # 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 # No longer invokes a helper program. We run gpg in batch mode without # tty to work-around old problems. # 2005-11-07 Russ Allbery # 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 file 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", "Sign Release file for $path with key '$gpgkey'", 3); } else { cmdaction("gpg -a -b -s -u $gpgkey " . "-o $path/Release.gpg $path/Release", "Sign 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 # Written. # 2004-08-09 Ola Lundqvist # Add merging of binary-all Packages file. # 2005-05-01 Daniel Leidert # Modified to add bzip2 support and handle contents-all in a proper way. # 2005-05-02 Ola Lundqvist # Bugfix for bzip2 support. # 2005-08-20 Russ Allbery # Call generateRelease for Release file support (optionally signed). # 2007-10-09 Turbo Fredriksson # 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 ; close ALL; close ARCH; cmdaction("gzip $d/Contents-$a -c > $d/Contents-$a.gz", "Gzip merged Contents files $d/Contents-$a", 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 ; close ALL; close ARCH; cmdaction("gzip $d/$s/$a/Packages -c > $d/$s/$a/Packages.gz", "Gzip merged Packages file $d/$s/$a/Packages", 3); if ($bzip) { cmdaction("bzip2 $d/$s/$a/Packages -c > $d/$s/$a/Packages.bz2", "Bzip merged Packages file $d/$s/$a/Packages", 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 # Written using parts of handleSorting. # Improved changes file verification structure. # 2005-05-06 Daniel Leidert # Add arg to handle signature verification in inputdir and distinput-dirs # independetly. # 2006-11-24 HÃ¥kon Stordahl # 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 # Moved from START section to this subprocedure. # 2005-04-xx Bob Proulx # Added support for .changes files in distinputdir. # 2005-04-30 Ola Lundqvist # Modified support for .changes files in distinput dir. # 2005-05-01 Ola Lundqvist # Broke out .changes file handling to a separate function # findAndSortChangesFiles. # 2005-05-06 Daniel Leidert # Add signatur checking setting to arguments given to # findAndSortChangesFiles(). # 2007-10-09 Turbo Fredriksson # 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/ 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 # Moved from START section to this subprocedure. # 2004-08-09 Ola Lundqvist # Call createRelease to build Release files. # 2007-10-08 Turbo Fredriksson # 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", "Symlink $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 # Written. # 2007-10-09 Turbo Fredriksson # 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 # Write function based on the code from Turbo Fredriksson # in function verifyChangesFile below. # 2007-10-09 Turbo Fredriksson # 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 # Write function based on the code from Turbo Fredriksson # in function verifyChangesFile below. # 2007-10-09 Turbo Fredriksson # 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 # Split out parts of handleChangesFile to this proc. # 2005-05-01 Ola Lundqvist # 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 # Add arg to handle signature verification in inputdir and distinput-dirs # independetly. # 2007-10-08 Turbo Fredriksson # Stat only existing files. # 2007-10-08 Ola Lundqvist # Correct indention (as Turbo explained). # 2007-10-08 Turbo Fredriksson # 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 # 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 # 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 # 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 # Taken from the main script. Cut and paste with simple changes. # 2003-03-13 Ola Lundqvist # Added mailSuccess command thing. # 2003-06-10 Ola Lundqvist # 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 # Split out parts of this function to parseChangesFile. # 2007-10-09 Turbo Fredriksson # 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 # Switched to using CMeta for ChangeLog meta information. # 2005-05-01 Ola Lundqvist # Modified reject cause. # 2005-05-06 Daniel Leidert # Fixed move-command and check for .changes file. # 2007-10-09 Turbo Fredriksson # Change in foreach to use my variable. # Create reject log code. # 2007-10-09 Ola Lundqvist # 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 # Taken from the main script. Cut and paste with simple changes. # 2006-06-11 Michael Hanke # Only remove source tarball file if not referenced by any other .changes file. # 2006-07-20 Ola Lundqvist # Changed indentation. # 2007-10-08 Turbo Fredriksson # Distmapping for files. # 2007-10-08 Turbo Fredriksson # 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 # 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", "Install $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 = ) { 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", "Remove $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 # Wrote it. # 2003-03-14 Ola Lundqvist # Now CConf{ChangesFile} is changed when copying it. # 2007-10-08 Turbo Fredriksson # Distmapping for files. # 2007-10-09 Turbo Fredriksson # 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 # 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 # Written. # Arguments: $lockfile # Returns: nothing ############################################################################### sub createLockExit($) { my ($lockfile) = @_; if (-e $lockfile) { pdebug(2, "Lockfile exists in distribution directory, skipping."); } cmdaction("touch $lockfile", "Create lockfile $lockfile", 2); } ############################################################################### # Name: removeLockfile # Description: Removes the lockfile. # Arguments: none # Needs: $rmcmd $lockfile # Returns: nothing # Changelog: # 2002-01-22 Ola Lundqvist # Written. ############################################################################### sub removeLockExit() { my ($lockfile) = @_; removeLockfile($lockfile); exit; } ############################################################################### # Name: removeLockfile # Description: Removes the lockfile. # Arguments: $lockfile # Returns: nothing # Changelog: # 2002-01-22 Ola Lundqvist # Written. ############################################################################### sub removeLockfile() { my ($lockfile) = @_; cmdaction("rm $lockfile", "Remove 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 # Written. # 2006-02-25 Yaroslav Halchenko and # Ola Lundqvist # 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 # 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 # 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 # Written with info from parseChanges. # 2003-02-12 Ola Lundqvist # Added ChangesFile to CConf hash. # 2007-10-09 Turbo Fredriksson # 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 # Written. # 2001-06-26 Ola Lundqvist # Changed print to pdebug. # 2002-09-11 Ola Lundqvist # Added uploaders field to the description. # 2003-02-12 Ola Lundqvist # Added ChangesFile to CConf hash. # 2003-03-14 Ola Lundqvist # Switched to using CMeta for ChangeLog meta information. # 2005-05-01 Ola Lundqvist # Renamed to parseChangesFile. # 2006-03-25 J�r�my Bobbio # 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 = ) { $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 # Written. # 2007-10-09 Turbo Fredriksson # 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 # 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 # Written. ############################################################################### sub secondIfNotEmpty ($$) { my ($p1, $p2) = @_; if (defined $p2 && $p2 !~ /^\s*$/) { return $p2; } return $p1; } ############################################################################### # Name: check_commands # Description: Check command available through the hash %cmds # Arguments: %include_hr: set of commands to check # they must be available into the hash %cmds # %exclude_hr: set of commands to exclude from the check # they must be available into the hash %cmds # Uses: %cmds # Changelog: # 2004 Michael Rash # Function written (fwknop). # 2008-09-28 Michael Rash # Updated (fwknop). # 2009-03-15 Franck Joncourt # Taken from fwknop (cipherdyne.com) (see changelog above) # and updated to suite debarchiver. ############################################################################### sub check_commands() { my ($include_hr, $exclude_hr) = @_; my @path = qw( /bin /sbin /usr/bin /usr/sbin /usr/local/bin /usr/local/sbin ); for my $cmd (keys %cmds) { if (keys %$include_hr) { next unless defined $include_hr->{$cmd}; } if (keys %$exclude_hr) { next if defined $exclude_hr->{$cmd}; } unless (-x $cmds{$cmd}) { my $found = 0; pdebug(4, "$cmd not located/executable at $cmds{$cmd}\n"); PATH: for my $dir (@path) { if (-x "${dir}/${cmd}") { $cmds{$cmd} = "${dir}/${cmd}"; $found = 1; last PATH; } } if ($found) { pdebug(4,"Found $cmd at $cmds{$cmd}\n"); } else { $err = 1; pdebug(4, "Could not find $cmd anywhere."); return 1; } } unless (-x $cmds{$cmd}) { pdebug(4, "Command $cmd is located at $cmds{$cmd}, but is not executable by uid: $<"); return 1; } } return 0; } ############################################################################### # Name: check_mailconfig # Description: Check the mail settings # Arguments: none # Uses: @mailsearch, %cmds, $usermailcmd, $mailformat # Changelog: # 2009-03-15 Franck Joncourt # Written ############################################################################### sub check_mailconfig() { # If the user defines his own mail command through the --mailcmd option, # we check which mail format has to be used according to the --mailformat # option. Sendmail is the default behavior. if ( ($mailformat ne "") && ($usermailcmd eq "") ) { pdebug(2, "The mailformat option must be used in conjunction to the mailcmd option."); } elsif ( ($mailformat eq "sendmail") || ($mailformat eq "") ) { @mailsearch = ("sendmail", "mail"); } elsif ($mailformat eq "mail") { @mailsearch = ("mail", "sendmail"); } else { pdebug(2, "The mailformat option only supports either sendmail or mail format."); } # Check whether the user has specified its own mail command or not. # The full path to this one is stored in the cmd specify by first # value in the array $mailformat. if ($usermailcmd ne "") { if (!File::Spec->file_name_is_absolute($usermailcmd)) { $usermailcmd = File::Spec->rel2abs($usermailcmd); } $usermailcmd !~ m|^(.*\/)+(.*)|; $cmds{$2} = $usermailcmd; $usermailcmd = $2; my $err = &check_commands({$usermailcmd => ''}, {}); if ($err) { pdebug(2, "Unable to find $usermailcmd"); } $cmds{$mailsearch[0]} = $cmds{$usermailcmd}; } # Go through all of the mail commands, find one available and remove # the others from the hash. my $nberr = 0; my $found = 0; foreach $cmd (@mailsearch) { my $err = &check_commands({$cmd => ''}, {}); if ($err) { delete $cmds{$cmd}; $nberr++; } elsif ($found == 0) { $found = 1; } else { delete $cmds{$cmd}; } } if ($nberr >= @mailsearch) { pdebug(2, "No mail command has been found."); } } __END__ ############################################################################### ############################# DOCUMENTATION ################################### ############################################################################### =head1 NAME debarchiver - Tool to sort debian packages into a package archive. =head1 SYNOPSIS debarchiver [options] =head1 DESCRIPTION The debian archiver is a tool that installs debian packages into a file structure suitable for apt-get, aptitude, dselect and similar tools. This can be used for updating the Debian system. It is meant to be used by local administrators that need special packages, or tweaked versions to ease administration. The file structure is based on the potato file structure and does not support package pools. =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. The default is $cachedir. =item B<--cinstall> dir Where the .changes file will be installed to. Use the empty string to remove the .changes file instead. The default is $cinstall. =item B<--configfile> file Specifies an extra configuration file to read. Will be read after etc configuration and after user configuration files. =item B<--copycmd> The install command to use where the default is $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 will reside and where the $distrib/$major/$arch/$section directory structure will be created. The default is $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 what binary packages should be installed even if they do not have a .changes file. The default is $distinputcriteria. =item B<--gpgkey> The GnuPG key to use to sign the archive. =item B<--gpgpassfile> The file that provides the password to GnuPG. =item B<--help> Prints this information. =item B<-i | --input | --indir | --inputdir> dir This is the directory where debarchiver will look for new package versions and corresponding *.changes files that should be installed to the --dest directory. The default is $instdir. =item B<--ignoredestcheck> Force install of .changes file even if some files specified in the .changes file already exists with wrong size or md5 hash. =item B<--incompletetime> The time to allow .changes file to be incomplete in seconds. The default is 24 hours. =item B<--index | -x> Automatically run apt-ftparchive after all new packages are installed. Use this *or* --autoscan, not both. =item B<--instcmd> DEPRECATED! =item B<--lockfile> file The lockfile to use. The default is $lockfile. =item B<--mailcmd> The command to use to send emails. The default behavior is to use the sendmail command. =item B<--mailformat> Defines the format to be used to send emails with, by the command specified by --mailfrom. Only 'sendmail' and 'mail' formats are supported. By default debarchiver assumes 'sendmail' format. The argument can be one of the following: sendmail = use of the sendmail format mail = use of the mail format =item B<--mailfrom> Specify mail sender. =item B<--majordefault> Default major section to use. The default is 'main'. =item B<--movecmd> Command to move files (currently not used at all). =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<--quit-level> level On what level to quit the application, see debug level. =item B<--rmcmd> The remove command to use. The default is $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*' (dpkg-scanpackages and dpkg-scansources) 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<-v | --version> Prints the version string. =back =head1 CONFIGURATION FILES You can also place configuration files with the following names (in the 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. In the above files 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 a line that states '1;'. =over 4 =item B<$bzip> If set to 0 no bzip2 files will be generated. If set to 1 bzip2 files will be generated. =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. The default is $distinputcriteria. =item B<%distinputdirs> Directories (distribution => dir) to be searched for extra binary packages that does not need a .changes file to be installed but match $distinputcriteria. The default is to accept 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 cause uploads to a specific queue to place the package into that distribution directly. =item B<$gpgkey> The 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 interactively when using this option so that you can supply the passphrase. =item B<$gpgpassfile> The file that contains the passphrase for the GnuPG key. See $gpgkey for more information. =item B<$ignoredestcheck> Force install of .changes file even if some files specified in the .changes file already exist with wrong size or md5 hash. Default to 0 (do not ignore). =item B<$incompletetime> Time to allow .changes files to be incomplete in seconds. Useful for slow uploads. The default is 24 hours. =item B<$inputdir> The input directory (no effect in $inputconfigfile). =item B<$lockfile> The lockfile to use. The default is $lockfile. =item B<@mailtos> An array of strings that will receive emails. 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<$mailformat> The format to use to send emails (see --mailformat above). =item B<$mailfrom> Specifies the sender of emails. The default is 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<$verifysignaturesdistinput> Choose to enable (1) or disable (2) signature verification for packages uploaded into %distinputdirs. This works independently from $verifysignatures. =item B<$usermailcmd> It allows the user to tell debarchiver to use a specific command to send emails. You may also want to specify the mailformat your mail command handles by setting the value of the $mailformat variable. Using the --mailcmd option on the command line will superseed this variable. =back =head1 PACKAGE INDEXING There are two ways to generate the indexes that B relies on. Using B<--autoscanpackages>, B<--autoscansources>, or B<--autoscan> will use B and B. 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 option will call B to index the package tree. B can also generate Contents files (for use with B), and can optionally use a cache of package information to speed up multiple runs. The B 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 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 (chooses between --index and --autoscan right now). =head1 REJECT Changes files are rejected in the following conditions: * 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. * Verify signatures is enabled and signature do not match. =head1 FILES B =head1 SEE ALSO B(1) =head1 AUTHOR Ola Lundqvist =cut