diff options
Diffstat (limited to '')
-rwxr-xr-x | scripts/debuild.pl | 1229 |
1 files changed, 1229 insertions, 0 deletions
diff --git a/scripts/debuild.pl b/scripts/debuild.pl new file mode 100755 index 0000000..fa6f94c --- /dev/null +++ b/scripts/debuild.pl @@ -0,0 +1,1229 @@ +#!/usr/bin/perl + +# Perl version of Christoph Lameter's build program, renamed debuild. +# Written by Julian Gilbey, December 1998. + +# Copyright 1999-2003, Julian Gilbey <jdg@debian.org> +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <https://www.gnu.org/licenses/>. + +# We will do simple option processing. The calling syntax of this +# program is: +# +# debuild [<debuild options>] -- binary|binary-arch|binary-indep|clean ... +# or +# debuild [<debuild options>] [<dpkg-buildpackage options>] +# [--lintian-opts <lintian options>] +# +# In the first case, debuild will simply run debian/rules with the +# given parameter. Available options are listed in usage() below. +# +# In the second case, the behaviour is to run dpkg-buildpackage and +# then to run lintian on the resulting .changes file. +# Lintian options may be specified after --lintian-opts; all following +# options will be passed only to lintian. +# +# As this may be running setuid, we make sure to clean out the +# environment before we perform the build, subject to any -e etc. +# options. Also wise for building the packages, anyway. +# We don't put /usr/local/bin in the PATH as Debian +# programs will presumably be built without the use of any locally +# installed programs. This could be changed, but in which case, +# please add /usr/local/bin at the END so that you don't get any +# unexpected behaviour. + +# We will try to preserve the locale variables, but if it turns out that +# this harms the package building process, we will clean them out too. +# Please file a bug report if this is the case! + +use strict; +use warnings; +use 5.008; +use File::Basename; +use filetest 'access'; +use Cwd; +use Dpkg::Changelog::Parse qw(changelog_parse); +use Dpkg::IPC; +use IO::Handle; # for flushing +use vars qw(*BUILD *OLDOUT *OLDERR); # prevent a warning + +my $progname = basename($0); +my $modified_conf_msg; +my @warnings; + +# Predeclare functions +sub setDebuildHook; +sub setDpkgHook; +sub system_withecho(@); +sub run_hook ($$); +sub fatal($); + +sub usage { + print <<"EOF"; +First usage method: + $progname [<debuild options>] -- binary|binary-arch|binary-indep|clean ... + to run debian/rules with given parameter(s). Options here are + --no-conf, --noconf Don\'t read devscripts config files; + must be the first option given + --rootcmd=<gain-root-command>, -r<gain-root-command> + Command used to become root if $progname + not setuid root and the package needs (fake)root + (dpkg-buildpackage uses fakeroot by default if + not provided) + + --preserve-envvar=<envvar>, -e<envvar> + Preserve environment variable <envvar> + + --preserve-env Preserve all environment vars (except PATH) + + --set-envvar=<envvar>=<value>, -e<envvar>=<value> + Set environment variable <envvar> to <value> + + --prepend-path=<value> Prepend <value> to the sanitised PATH + + -d Skip checking of build dependencies + -D Force checking of build dependencies (default) + + --check-dirname-level N + How much to check directory names: + N=0 never + N=1 only if program changes directory (default) + N=2 always + + --check-dirname-regex REGEX + What constitutes a matching directory name; REGEX is + a Perl regular expression; the string \`PACKAGE\' will + be replaced by the package name; see manpage for details + (default: 'PACKAGE(-.+)?') + + --help, -h display this message + + --version show version and copyright information + +Second usage method: + $progname [<debuild options>] [<dpkg-buildpackage options>] + [--lintian-opts <lintian options>] + to run dpkg-buildpackage and then run lintian on the resulting + .changes file. + + Additional debuild options available in this case are: + + --lintian Run lintian (default) + --no-lintian Do not run lintian + --[no-]tgz-check Do [not] check for an .orig.tar.gz before running + dpkg-buildpackage if we have a Debian revision + (Default: check) + --username Run debrsign instead of debsign, using the + supplied credentials + + --dpkg-buildpackage-hook=HOOK + --clean-hook=HOOK + --dpkg-source-hook=HOOK + --build-hook=HOOK + --binary-hook=HOOK + --dpkg-genchanges-hook=HOOK + --final-clean-hook=HOOK + --lintian-hook=HOOK + --signing-hook=HOOK + --post-dpkg-buildpackage-hook=HOOK + These hooks run at the various stages of the + dpkg-buildpackage run. For details, see the + debuild manpage. They default to nothing, and + can be reset to nothing with --foo-hook='' + --clear-hooks Clear all hooks + + For available dpkg-buildpackage and lintian options, see their + respective manpages. + +Default settings modified by devscripts configuration files: +$modified_conf_msg +EOF +} + +sub version { + print <<"EOF"; +This is $progname, from the Debian devscripts package, version ###VERSION### +This code is copyright 1999-2003 by Julian Gilbey <jdg\@debian.org>, +all rights reserved. +Based on a shell-script program by Christoph Lameter. +This program comes with ABSOLUTELY NO WARRANTY. +You are free to redistribute this code under the terms of the +GNU General Public License, version 2 or later. +EOF +} + +# Start by reading configuration files and then command line +# The next stuff is somewhat boilerplate and somewhat not. +# It's complicated by the fact that the config files are in shell syntax, +# and we don't want to have to write a general shell parser in Perl. +# So we'll get the shell to do the work. Yuck. +# We allow DEBUILD_PRESERVE_ENVVARS="VAR1,VAR2,VAR3" +# and DEBUILD_SET_ENVVAR_VAR1=VAL1, DEBUILD_SET_ENVVAR_VAR2=VAR2. + +# Set default values before we start +my $preserve_env = 0; +my %save_vars; +my $root_command = ''; +my $run_lintian = 1; +my $lintian_exists = 0; +my @dpkg_extra_opts = (); +my @lintian_extra_opts = (); +my @lintian_opts = (); +my $checkbuilddep; +my $check_dirname_level = 1; +my $check_dirname_regex = 'PACKAGE(-.+)?'; +my $logging = 0; +my $tgz_check = 1; +my $prepend_path = ''; +my $username = ''; +my @hooks = ( + qw(dpkg-buildpackage clean dpkg-source build binary dpkg-genchanges + final-clean lintian signing post-dpkg-buildpackage) +); +my %hook; +@hook{@hooks} = ('') x @hooks; +# dpkg-buildpackage runs all hooks in the source tree, while debuild runs some +# in the parent directory. Use %externalHook to check which run out of tree +my %externalHook; +@externalHook{@hooks} = (0) x @hooks; +$externalHook{lintian} = 1; +$externalHook{signing} = 1; +$externalHook{'post-dpkg-buildpackage'} = 1; +# Track which hooks are run by dpkg-buildpackage vs. debuild +my %dpkgHook; +@dpkgHook{@hooks} = (1) x @hooks; +$dpkgHook{lintian} = 0; +$dpkgHook{signing} = 0; +$dpkgHook{'post-dpkg-buildpackage'} = 0; + +# First handle private options from cvs-debuild +my ($cvsdeb_file, $cvslin_file); +if (@ARGV and $ARGV[0] eq '--cvs-debuild') { + shift; + $check_dirname_level = 0; # no need to check dirnames if we're being + # called from cvs-debuild + if (@ARGV and $ARGV[0] eq '--cvs-debuild-deb') { + shift; + $cvsdeb_file = shift; + unless ($cvsdeb_file =~ m%^/dev/fd/\d+$%) { + fatal + "--cvs-debuild-deb is an internal option and should not be used"; + } + } + if (@ARGV and $ARGV[0] eq '--cvs-debuild-lin') { + shift; + $cvslin_file = shift; + unless ($cvslin_file =~ m%^/dev/fd/\d+$%) { + fatal + "--cvs-debuild-lin is an internal option and should not be used"; + } + } + if (defined $cvsdeb_file) { + local $/; + open DEBOPTS, $cvsdeb_file + or fatal "can't open cvs-debuild debuild options file: $!"; + my $opts = <DEBOPTS>; + close DEBOPTS; + + unshift @ARGV, split(/\0/, $opts, -1); + } + if (defined $cvslin_file) { + local $/; + open LINOPTS, $cvslin_file + or fatal "can't open cvs-debuild lin* options file: $!"; + my $opts = <LINOPTS>; + close LINOPTS; + + push @ARGV, split(/\0/, $opts, -1); + } +} + +if (@ARGV and $ARGV[0] =~ /^--no-?conf$/) { + $modified_conf_msg = " (no configuration files read)"; + shift; +} else { + my @config_files = ('/etc/devscripts.conf', '~/.devscripts'); + my %config_vars = ( + 'DEBUILD_PRESERVE_ENV' => 'no', + 'DEBUILD_PRESERVE_ENVVARS' => '', + 'DEBUILD_LINTIAN' => 'yes', + 'DEBUILD_ROOTCMD' => $root_command, + 'DEBUILD_TGZ_CHECK' => 'yes', + 'DEBUILD_DPKG_BUILDPACKAGE_HOOK' => '', + 'DEBUILD_CLEAN_HOOK' => '', + 'DEBUILD_DPKG_SOURCE_HOOK' => '', + 'DEBUILD_BUILD_HOOK' => '', + 'DEBUILD_BINARY_HOOK' => '', + 'DEBUILD_DPKG_GENCHANGES_HOOK' => '', + 'DEBUILD_FINAL_CLEAN_HOOK' => '', + 'DEBUILD_LINTIAN_HOOK' => '', + 'DEBUILD_SIGNING_HOOK' => '', + 'DEBUILD_PREPEND_PATH' => '', + 'DEBUILD_POST_DPKG_BUILDPACKAGE_HOOK' => '', + 'DEBUILD_SIGNING_USERNAME' => '', + 'DEVSCRIPTS_CHECK_DIRNAME_LEVEL' => 1, + 'DEVSCRIPTS_CHECK_DIRNAME_REGEX' => 'PACKAGE(-.+)?', + ); + my %config_default = %config_vars; + my $dpkg_opts_var = 'DEBUILD_DPKG_BUILDPACKAGE_OPTS'; + my $lintian_opts_var = 'DEBUILD_LINTIAN_OPTS'; + + my $shell_cmd; + # Set defaults + $shell_cmd .= qq[unset `set | grep "^DEBUILD_" | cut -d= -f1`;\n]; + foreach my $var (keys %config_vars) { + $shell_cmd .= qq[$var="$config_vars{$var}";\n]; + } + foreach my $var ($dpkg_opts_var, $lintian_opts_var) { + $shell_cmd .= "$var='';\n"; + } + $shell_cmd .= 'for file in ' . join(" ", @config_files) . "; do\n"; + $shell_cmd .= '[ -f $file ] && . $file; done;' . "\n"; + # Read back values + foreach my $var (keys %config_vars) { $shell_cmd .= "echo \$$var;\n" } + foreach my $var ($dpkg_opts_var, $lintian_opts_var) { + $shell_cmd .= "eval set -- \$$var;\n"; + $shell_cmd .= "echo \">>> $var BEGIN <<<\";\n"; + $shell_cmd + .= 'while [ $# -gt 0 ]; do printf "%s\n" "$1"; shift; done;' . "\n"; + $shell_cmd .= "echo \">>> $var END <<<\";\n"; + } + # Not totally efficient, but never mind + $shell_cmd + .= 'for var in `set | grep "^DEBUILD_SET_ENVVAR_" | cut -d= -f1`; do '; + $shell_cmd .= 'eval echo $var=\$$var; done;' . "\n"; + # print STDERR "Running shell command:\n$shell_cmd"; + my $shell_out = `/bin/bash -c '$shell_cmd'`; + # print STDERR "Shell output:\n${shell_out}End shell output\n"; + my @othervars; + (@config_vars{ keys %config_vars }, @othervars) = split /\n/, $shell_out, + -1; + + # Check validity + $config_vars{'DEBUILD_PRESERVE_ENV'} =~ /^(yes|no)$/ + or $config_vars{'DEBUILD_PRESERVE_ENV'} = 'no'; + $config_vars{'DEBUILD_LINTIAN'} =~ /^(yes|no)$/ + or $config_vars{'DEBUILD_LINTIAN'} = 'yes'; + $config_vars{'DEVSCRIPTS_CHECK_DIRNAME_LEVEL'} =~ /^[012]$/ + or $config_vars{'DEVSCRIPTS_CHECK_DIRNAME_LEVEL'} = 1; + $config_vars{'DEBUILD_TGZ_CHECK'} =~ /^(yes|no)$/ + or $config_vars{'DEBUILD_TGZ_CHECK'} = 'yes'; + + foreach my $var (sort keys %config_vars) { + if ($config_vars{$var} ne $config_default{$var}) { + $modified_conf_msg .= " $var=$config_vars{$var}\n"; + } + } + + # What did we find? + $preserve_env = $config_vars{'DEBUILD_PRESERVE_ENV'} eq 'yes' ? 1 : 0; + if ($config_vars{'DEBUILD_PRESERVE_ENVVARS'} ne '') { + my @preserve_vars = split /\s*,\s*/, + $config_vars{'DEBUILD_PRESERVE_ENVVARS'}; + foreach my $index (0 .. $#preserve_vars) { + my $var = $preserve_vars[$index]; + if ($var =~ /\*$/) { + $var =~ s/([^.])\*$/$1.\*/; + my @vars = grep /^$var$/, keys %ENV; + push @preserve_vars, @vars; + delete $preserve_vars[$index]; + } + } + @preserve_vars = map { $_ if defined $_ } @preserve_vars; + @save_vars{@preserve_vars} = (1) x scalar @preserve_vars; + } + $run_lintian = $config_vars{'DEBUILD_LINTIAN'} eq 'no' ? 0 : 1; + $root_command = $config_vars{'DEBUILD_ROOTCMD'}; + $tgz_check = $config_vars{'DEBUILD_TGZ_CHECK'} eq 'yes' ? 1 : 0; + $prepend_path = $config_vars{'DEBUILD_PREPEND_PATH'}; + $username = $config_vars{'DEBUILD_SIGNING_USERNAME'}; + $check_dirname_level = $config_vars{'DEVSCRIPTS_CHECK_DIRNAME_LEVEL'}; + $check_dirname_regex = $config_vars{'DEVSCRIPTS_CHECK_DIRNAME_REGEX'}; + + for my $hookname (@hooks) { + my $config_name = uc "debuild_${hookname}_hook"; + $config_name =~ tr/-/_/; + setDebuildHook($hookname, $config_vars{$config_name}); + } + + # Now parse the opts lists + if (shift @othervars ne ">>> $dpkg_opts_var BEGIN <<<") { + fatal "internal error: dpkg opts list missing proper header"; + } + while (($_ = shift @othervars) ne ">>> $dpkg_opts_var END <<<" + and @othervars) { + push @dpkg_extra_opts, $_; + } + if (!@othervars) { + fatal "internal error: dpkg opts list missing proper trailer"; + } + if (@dpkg_extra_opts) { + $modified_conf_msg + .= " $dpkg_opts_var='" . join(" ", @dpkg_extra_opts) . "'\n"; + } + + if (shift @othervars ne ">>> $lintian_opts_var BEGIN <<<") { + fatal "internal error: lintian opts list missing proper header"; + } + while (($_ = shift @othervars) ne ">>> $lintian_opts_var END <<<" + and @othervars) { + push @lintian_extra_opts, $_; + } + if (!@othervars) { + fatal "internal error: lintian opts list missing proper trailer"; + } + if (@lintian_extra_opts) { + $modified_conf_msg + .= " $lintian_opts_var='" . join(" ", @lintian_extra_opts) . "'\n"; + } + + # And what is left should be any ENV settings + foreach my $confvar (@othervars) { + $confvar =~ /^DEBUILD_SET_ENVVAR_([^=]*)=(.*)$/ or next; + $ENV{$1} = $2; + $save_vars{$1} = 1; + $modified_conf_msg .= " $1='$2'\n"; + } + + $modified_conf_msg ||= " (none)\n"; + chomp $modified_conf_msg; +} + +# We first check @dpkg_extra_opts for options which may affect us; +# these were set in a configuration file, so they have lower +# precedence than command line settings. The options we care about +# at this stage are: -r and those which affect the checkbuilddep setting + +foreach (@dpkg_extra_opts) { + /^-r(.*)$/ and $root_command = $1, next; + $_ eq '-d' and $checkbuilddep = 0, next; + $_ eq '-D' and $checkbuilddep = 1, next; +} + +# Check @ARGV for debuild options. +my @preserve_vars = qw(TERM HOME LOGNAME PGPPATH GNUPGHOME GPG_AGENT_INFO + DBUS_SESSION_BUS_ADDRESS GPG_TTY FAKEROOTKEY LANG DEBEMAIL); +@save_vars{@preserve_vars} = (1) x scalar @preserve_vars; +{ + no locale; + while (my $arg = shift) { + my $savearg = $arg; + my $opt = ''; + + $arg =~ /^(-h|--help)$/ and usage(), exit 0; + $arg eq '--version' and version(), exit 0; + + # Let's do the messy case first + if ($arg eq '--preserve-envvar') { + unless (defined($opt = shift)) { + fatal +"--preserve-envvar requires an argument,\nrun $progname --help for usage information"; + } + $savearg .= " $opt"; + } elsif ($arg =~ /^--preserve-envvar=(.*)/) { + $arg = '--preserve-envvar'; + $opt = $1; + } elsif ($arg eq '--set-envvar') { + unless (defined($opt = shift)) { + fatal +"--set-envvar requires an argument,\nrun $progname --help for usage information"; + } + $savearg .= " $opt"; + } elsif ($arg =~ /^--set-envvar=(.*)/) { + $arg = '--set-envvar'; + $opt = $1; + } + # dpkg-buildpackage now has a -e option, so we have to be + # careful not to confuse the two; their option will always have + # the form -e<maintainer email> or similar + elsif ($arg eq '-e') { + unless (defined($opt = shift)) { + fatal +"-e requires an argument,\nrun $progname --help for usage information"; + } + $savearg .= " $opt"; + if ($opt =~ /^\w+\*?$/) { $arg = '--preserve-envvar'; } + else { $arg = '--set-envvar'; } + } elsif ($arg =~ /^-e(\w+\*?)$/) { + $arg = '--preserve-envvar'; + $opt = $1; + } elsif ($arg =~ /^-e(\w+=.*)$/) { + $arg = '--set-envvar'; + $opt = $1; + } elsif ($arg =~ /^-e/) { + # seems like a dpkg-buildpackage option, so stop parsing + unshift @ARGV, $arg; + last; + } + + if ($arg eq '--preserve-envvar') { + if ($opt =~ /^\w+$/) { + $save_vars{$opt} = 1; + } elsif ($opt =~ /^\w+\*$/) { + $opt =~ s/([^.])\*$/$1.\*/; + my @vars = grep /^$opt$/, keys %ENV; + @save_vars{@vars} = (1) x scalar @vars; + } else { + push @warnings, + "Ignoring unrecognised/malformed option: $savearg"; + } + next; + } + if ($arg eq '--set-envvar') { + if ($opt =~ /^(\w+)=(.*)$/) { + $ENV{$1} = $2; + $save_vars{$1} = 1; + } else { + push @warnings, + "Ignoring unrecognised/malformed option: $savearg"; + } + next; + } + + $arg eq '--preserve-env' and $preserve_env = 1, next; + if ($arg eq '-E') { + push @warnings, +"-E is deprecated in debuild, as dpkg-buildpackage now uses it.\nPlease use --preserve-env instead in future.\n"; + $preserve_env = 1; + next; + } + $arg eq '--no-lintian' and $run_lintian = 0, next; + $arg eq '--lintian' and $run_lintian = 1, next; + if ($arg eq '--rootcmd') { + unless (defined($root_command = shift)) { + fatal +"--rootcmd requires an argument,\nrun $progname --help for usage information"; + } + next; + } + $arg =~ /^--rootcmd=(.*)/ and $root_command = $1, next; + if ($arg eq '-r') { + unless (defined($opt = shift)) { + fatal +"-r requires an argument,\nrun $progname --help for usage information"; + } + $root_command = $opt; + next; + } + $arg eq '--tgz-check' and $tgz_check = 1, next; + $arg =~ /^--no-?tgz-check$/ and $tgz_check = 0, next; + $arg =~ /^-r(.*)/ and $root_command = $1, next; + if ($arg =~ /^--check-dirname-level=(.*)$/) { + $arg = '--check-dirname-level'; + unshift @ARGV, $1; + } # fall through and let the next one handle it ;-) + if ($arg eq '--check-dirname-level') { + unless (defined($opt = shift)) { + fatal +"--check-dirname-level requires an argument,\nrun $progname --help for usage information"; + } + if ($opt =~ /^[012]$/) { $check_dirname_level = $opt; } + else { + fatal +"unrecognised --check-dirname-level value (allowed are 0,1,2)"; + } + next; + } + if ($arg eq '--check-dirname-regex') { + unless (defined($opt = shift)) { + fatal +"--check-dirname-regex requires an argument,\nrun $progname --help for usage information"; + } + $check_dirname_regex = $opt; + next; + } + if ($arg =~ /^--check-dirname-regex=(.*)$/) { + $check_dirname_regex = $1; + next; + } + + if ($arg eq '--prepend-path') { + unless (defined($opt = shift)) { + fatal +"--prepend-path requires an argument,\nrun $progname --help for usage information"; + } + $prepend_path = $opt; + next; + } + if ($arg =~ /^--prepend-path=(.*)$/) { + $prepend_path = $1; + next; + } + + if ($arg eq '--username') { + unless (defined($opt = shift)) { + fatal +"--username requires an argument,\nrun $progname --help for usage information"; + } + $username = $opt; + next; + } + if ($arg =~ /^--username=(.*)$/) { + $username = $1; + next; + } + + if ($arg =~ /^--no-?conf$/) { + fatal "$arg is only acceptable as the first command-line option!"; + } + $arg eq '-d' and $checkbuilddep = 0, next; + $arg eq '-D' and $checkbuilddep = 1, next; + + # hooks... + if ($arg =~ /^--(.*)-hook$/) { + my $argkey = $1; + unless (exists $hook{$argkey}) { + fatal +"unknown hook $arg,\nrun $progname --help for usage information"; + } + unless (defined($opt = shift)) { + fatal +"$arg requires an argument,\nrun $progname --help for usage information"; + } + + setDebuildHook($argkey, $opt); + next; + } + + if ($arg =~ /^--(.*?)-hook=(.*)/) { + my $argkey = $1; + my $opt = $2; + + unless (exists $hook{$argkey}) { + fatal +"unknown hook option $arg,\nrun $progname --help for usage information"; + } + + setDebuildHook($argkey, $opt); + next; + } + + if ($arg =~ /^--hook-(check|sign|done)=(.*)$/) { + my $name = $1; + my $opt = $2; + unless (defined($opt)) { + fatal +"$arg requires an argmuent,\nrun $progname --help for usage information"; + } + if ($name eq 'check') { + setDpkgHook('lintian', $opt); + } elsif ($name eq 'sign') { + setDpkgHook('signing', $opt); + } else { + setDpkgHook('post-dpkg-buildpackage', $opt); + } + next; + } + + if ($arg eq '--clear-hooks') { $hook{@hooks} = ('') x @hooks; next; } + + # Not a debuild option, so give up. + unshift @ARGV, $arg; + last; + } +} + +if ($save_vars{'PATH'}) { + # Untaint PATH. Very dangerous in general, but anyone running this + # as root can do anything anyway. + $ENV{'PATH'} =~ /^(.*)$/; + $ENV{'PATH'} = $1; +} else { + $ENV{'PATH'} = "/usr/sbin:/usr/bin:/sbin:/bin:/usr/bin/X11"; + $ENV{'PATH'} = join(':', $prepend_path, $ENV{'PATH'}) if $prepend_path; +} +$save_vars{'PATH'} = 1; +$ENV{'TERM'} = 'dumb' unless exists $ENV{'TERM'}; + +# Store a few variables for safe keeping. +my %store_vars; +foreach my $var (( + 'DBUS_SESSION_BUS_ADDRESS', 'DISPLAY', + 'GNOME_KEYRING_SOCKET', 'GPG_AGENT_INFO', + 'SSH_AUTH_SOCK', 'XAUTHORITY' + ) +) { + $store_vars{$var} = $ENV{$var} if defined $ENV{$var}; +} + +unless ($preserve_env) { + foreach my $var (keys %ENV) { + delete $ENV{$var} + unless $save_vars{$var} + or $var =~ /^(LC|DEB)_[A-Z_]+$/ + or $var =~ /^(C(PP|XX)?|LD|F)FLAGS(_APPEND)?$/ + or $var eq 'SOURCE_DATE_EPOCH'; + } +} + +umask 022; + +# Start by duping STDOUT and STDERR +open OLDOUT, ">&", \*STDOUT or fatal "can't dup stdout: $!\n"; +open OLDERR, ">&", \*STDERR or fatal "can't dup stderr: $!\n"; + +# Look for the debian changelog +my $chdir = 0; +until (-r 'debian/changelog') { + $chdir = 1; + chdir '..' or fatal "can't chdir ..: $!"; + if (cwd() eq '/') { + fatal +"cannot find readable debian/changelog anywhere!\nAre you in the source code tree?"; + } +} + +# Find the source package name and version number +my %changelog; +my $c = changelog_parse(); +@changelog{ 'Source', 'Version', 'Distribution' } + = @{$c}{ 'Source', 'Version', 'Distribution' }; + +fatal "no package name in changelog!" + unless exists $changelog{'Source'}; +my $pkg = $changelog{'Source'}; +fatal "no version number in changelog!" + unless exists $changelog{'Version'}; +my $version = $changelog{'Version'}; +(my $sversion = $version) =~ s/^\d+://; +(my $uversion = $sversion) =~ s/-[a-z0-9+\.]+$//i; + +# Is the directory name acceptable? +if ($check_dirname_level == 2 + or ($check_dirname_level == 1 and $chdir)) { + my $re = $check_dirname_regex; + $re =~ s/PACKAGE/\\Q$pkg\\E/g; + my $gooddir; + if ($re =~ m%/%) { $gooddir = eval "cwd() =~ /^$re\$/;"; } + else { $gooddir = eval "basename(cwd()) =~ /^$re\$/;"; } + + if (!$gooddir) { + my $pwd = cwd(); + die <<"EOF"; +$progname: found debian/changelog for package $pkg in the directory + $pwd +but this directory name does not match the package name according to the +regex $check_dirname_regex. + +To run $progname on this package, see the --check-dirname-level and +--check-dirname-regex options; run $progname --help for more info. +EOF + } +} + +if (!-f "debian/rules") { + my $cwd = cwd(); + fatal +"found debian/changelog in directory\n $cwd\nbut there's no debian/rules there! Are you in the source code tree?"; +} + +if (!-x _ ) { + push @warnings, "Making debian/rules executable!\n"; + chmod 0755, "debian/rules" + or fatal "couldn't make debian/rules executable: $!"; +} + +# Pick up superuser privileges if we are running set[ug]id root +my $uid = $<; +if ($< != 0 && $> == 0) { $< = $> } +my $gid = $(; +if ($( != 0 && $) == 0) { $( = $) } + +# Our first task is to parse the command line options. + +# dpkg-buildpackage variables explicitly initialised in dpkg-buildpackage +my $nosign; +my $forcesign; +my $signsource = $changelog{Distribution} ne 'UNRELEASED'; +my $signchanges = $changelog{Distribution} ne 'UNRELEASED'; +my $signbuildinfo = $changelog{Distribution} ne 'UNRELEASED'; +my $binarytarget = 'binary'; +my $since = ''; +my $usepause = 0; + +# extra dpkg-buildpackage variables not initialised there +my $sourceonly = ''; +my $binaryonly = ''; +my $targetarch = ''; +my $targetgnusystem = ''; + +my $dirn = basename(cwd()); + +# and one for us +my @debsign_opts = (); +# and one for dpkg-buildpackage if needed +my @dpkg_opts = qw(-us -uc -ui); + +my %debuild2dpkg = ( + 'dpkg-buildpackage' => 'init', + 'clean' => 'preclean', + 'dpkg-source' => 'source', + 'build' => 'build', + 'binary' => 'binary', + 'dpkg-genchanges' => 'changes', + 'final-clean' => 'postclean', +); + +for my $h_name (@hooks) { + if (exists $debuild2dpkg{$h_name} && $hook{$h_name}) { + push(@dpkg_opts, + sprintf('--hook-%s=%s', $debuild2dpkg{$h_name}, $hook{$h_name})); + delete $hook{$h_name}; + } +} + +# Parse dpkg-buildpackage options +# First process @dpkg_extra_opts from above + +foreach (@dpkg_extra_opts) { + $_ eq '-h' + and warn "You have a -h option in your configuration file! Ignoring.\n", + next; + /^-r/ and next; # already been processed + /^-p/ and push(@debsign_opts, $_), next; # Key selection options + /^-k/ and push(@debsign_opts, $_), next; # Ditto + /^-[dD]$/ and next; # already been processed + $_ eq '-us' and $signsource = 0, next; + $_ eq '--unsigned-source' and $signsource = 0, next; + $_ eq '-uc' and $signchanges = 0, next; + $_ eq '--unsigned-changes' and $signchanges = 0, next; + $_ eq '-ui' and $signbuildinfo = 0, next; + $_ eq '--unsigned-buildinfo' and $signbuildinfo = 0, next; + $_ eq '--no-sign' and $nosign = 1, next; + $_ eq '--force-sign' and $forcesign = 1, next; + $_ eq '-ap' and $usepause = 1, next; + /^-a(.*)/ and $targetarch = $1, push(@dpkg_opts, $_), next; + $_ eq '-tc' and push(@dpkg_opts, $_), next; + /^-t(.*)/ and $targetgnusystem = $1, push(@dpkg_opts, $_), next; # Ditto + $_ eq '-b' and $binaryonly = $_, $binarytarget = 'binary', + push(@dpkg_opts, $_), next; + $_ eq '-B' and $binaryonly = $_, $binarytarget = 'binary-arch', + push(@dpkg_opts, $_), next; + $_ eq '-A' and $binaryonly = $_, $binarytarget = 'binary-indep', + push(@dpkg_opts, $_), next; + $_ eq '-S' and $sourceonly = $_, push(@dpkg_opts, $_), next; + $_ eq '-F' and $binarytarget = 'binary', push(@dpkg_opts, $_), next; + $_ eq '-G' and $binarytarget = 'binary-arch', push(@dpkg_opts, $_), next; + $_ eq '-g' and $binarytarget = 'binary-indep', push(@dpkg_opts, $_), next; + + if (/^--build=(.*)$/) { + my $argstr = $_; + my @builds = split(/,/, $1); + my ($binary, $source); + for my $build (@builds) { + if ($build =~ m/^(?:binary|full)$/) { + $source++ if $1 eq 'full'; + $binary++; + $binarytarget = 'binary'; + } elsif ($build eq 'any') { + $binary++; + $binarytarget = 'binary-arch'; + } elsif ($build eq 'all') { + $binary++; + $binarytarget = 'binary-indep'; + } + } + $binaryonly = (!$source && $binary); + $sourceonly = ($source && !$binary); + push(@dpkg_opts, $argstr); + } + /^-v(.*)/ and $since = $1, push(@dpkg_opts, $_), next; + /^-m(.*)/ and push(@debsign_opts, $_), push(@dpkg_opts, $_), next; + /^-e(.*)/ and push(@debsign_opts, $_), push(@dpkg_opts, $_), next; + push(@dpkg_opts, $_); +} + +while ($_ = shift) { + $_ eq '-h' and usage(), exit 0; + /^-r(.*)/ and $root_command = $1, next; + /^-p/ and push(@debsign_opts, $_), next; # Key selection options + /^-k/ and push(@debsign_opts, $_), next; # Ditto + $_ eq '-us' and $signsource = 0, next; + $_ eq '--unsigned-source' and $signsource = 0, next; + $_ eq '-uc' and $signchanges = 0, next; + $_ eq '--unsigned-changes' and $signchanges = 0, next; + $_ eq '-ui' and $signbuildinfo = 0, next; + $_ eq '--unsigned-buildinfo' and $signbuildinfo = 0, next; + $_ eq '--no-sign' and $nosign = 1, next; + $_ eq '--force-sign' and $forcesign = 1, next; + $_ eq '-ap' and $usepause = 1, next; + /^-a(.*)/ and $targetarch = $1, push(@dpkg_opts, $_), next; + $_ eq '-tc' and push(@dpkg_opts, $_), next; + /^-t(.*)/ and $targetgnusystem = $1, next; + $_ eq '-b' and $binaryonly = $_, $binarytarget = 'binary', + push(@dpkg_opts, $_), next; + $_ eq '-B' and $binaryonly = $_, $binarytarget = 'binary-arch', + push(@dpkg_opts, $_), next; + $_ eq '-A' and $binaryonly = $_, $binarytarget = 'binary-indep', + push(@dpkg_opts, $_), next; + $_ eq '-S' and $sourceonly = $_, push(@dpkg_opts, $_), next; + $_ eq '-F' and $binarytarget = 'binary', push(@dpkg_opts, $_), next; + $_ eq '-G' and $binarytarget = 'binary-arch', push(@dpkg_opts, $_), next; + $_ eq '-g' and $binarytarget = 'binary-indep', push(@dpkg_opts, $_), next; + + if (/^--build=(.*)$/) { + my $argstr = $_; + my @builds = split(/,/, $1); + my ($binary, $source); + for my $build (@builds) { + if ($build eq 'full') { + $source++; + $binary++; + $binarytarget = 'binary'; + } elsif ($build eq 'binary') { + $binary++; + $binarytarget = 'binary'; + } elsif ($build eq 'any') { + $binary++; + $binarytarget = 'binary-arch'; + } elsif ($build eq 'all') { + $binary++; + $binarytarget = 'binary-indep'; + } + } + $binaryonly = (!$source && $binary); + $sourceonly = ($source && !$binary); + push(@dpkg_opts, $argstr); + } + /^-v(.*)/ and $since = $1, push(@dpkg_opts, $_), next; + /^-m(.*)/ and push(@debsign_opts, $_), push(@dpkg_opts, $_), next; + /^-e(.*)/ and push(@debsign_opts, $_), push(@dpkg_opts, $_), next; + + # these non-dpkg-buildpackage options make us stop + if ($_ eq '--lintian-opts') { + unshift @ARGV, $_; + last; + } + if ($_ eq '--') { + last; + } + push(@dpkg_opts, $_); +} + +# Pick up lintian options if necessary +if (@ARGV) { + # Check that option is sensible + if ($ARGV[0] eq '--lintian-opts') { + if (!$run_lintian) { + push @warnings, "$ARGV[0] option given but not running lintian!"; + } + shift; + push(@lintian_opts, @ARGV); + undef @ARGV; + } +} + +if ($nosign) { + $signchanges = 0; + $signsource = 0; + $signbuildinfo = 0; +} + +if ($forcesign) { + $signchanges = 1; + $signsource = 1; + $signbuildinfo = 1; +} + +if ($signchanges == 1 and $signsource == 0) { + push @warnings, "Setting -us without setting -uc, signing .dsc anyway\n"; +} + +if ($signchanges == 1 and $signbuildinfo == 0) { + push @warnings, + "Setting -ui without setting -uc, signing .buildinfo anyway\n"; +} + +# Next dpkg-buildpackage steps: +# mustsetvar package/version have been done above; we've called the +# results $pkg and $version +# mustsetvar maintainer is only needed for signing, so we leave that +# to debsign or dpkg-sig +# Call to dpkg-architecture to set DEB_{BUILD,HOST}_* environment +# variables +my @dpkgarch = 'dpkg-architecture'; +if ($targetarch) { + push @dpkgarch, "-a${targetarch}"; +} +if ($targetgnusystem) { + push @dpkgarch, "-t${targetgnusystem}"; +} +push @dpkgarch, '-f'; + +my $archinfo; +spawn( + exec => [@dpkgarch], + to_string => \$archinfo, + wait_child => 1 +); +foreach (split /\n/, $archinfo) { + /^(.*)=(.*)$/ and $ENV{$1} = $2; +} + +# We need to do the arch, pv, pva stuff to figure out +# what the changes file will be called, +my ($arch, $dsc, $changes, $build); +if ($sourceonly) { + $arch = 'source'; +} elsif ($binarytarget eq 'binary-indep') { + $arch = 'all'; +} else { + $arch = $ENV{DEB_HOST_ARCH}; +} + +# Handle dpkg source format "3.0 (git)" packages (no tarballs) +if (-r "debian/source/format") { + open FMT, "debian/source/format" or die $!; + my $srcfmt = <FMT>; + close FMT; + chomp $srcfmt; + if ($srcfmt eq "3.0 (git)") { $tgz_check = 0; } +} + +$dsc = "${pkg}_${sversion}.dsc"; +my $orig_prefix = "${pkg}_${uversion}.orig.tar"; +my $origdir = basename(cwd()) . ".orig"; +if ( !$binaryonly + and $tgz_check + and $uversion ne $sversion + and !-f "../${orig_prefix}.bz2" + and !-f "../${orig_prefix}.lzma" + and !-f "../${orig_prefix}.gz" + and !-f "../${orig_prefix}.xz" + and !-d "../$origdir") { + print STDERR "This package has a Debian revision number but there does" + . " not seem to be\nan appropriate original tar file or .orig" + . " directory in the parent directory;\n(expected one of" + . " ${orig_prefix}.gz, ${orig_prefix}.bz2,\n${orig_prefix}.lzma, " + . " ${orig_prefix}.xz or $origdir)\ncontinue anyway? (y/n) "; + my $ans = <STDIN>; + exit 1 unless $ans =~ /^y/i; +} + +# Convert debuild-specific _APPEND variables to those recognized by +# dpkg-buildpackage +my @buildflags = qw(CPPFLAGS CFLAGS CXXFLAGS FFLAGS LDFLAGS); +foreach my $flag (@buildflags) { + if (exists $ENV{"${flag}_APPEND"}) { + $ENV{"DEB_${flag}_APPEND"} = delete $ENV{"${flag}_APPEND"}; + } +} + +if (defined($checkbuilddep)) { + unshift @dpkg_opts, ($checkbuilddep ? "-D" : "-d"); +} +unshift @dpkg_opts, "-r$root_command" if $root_command; + +if (@ARGV) { + # Run each rule + for my $target (@ARGV) { + system_withecho('dpkg-buildpackage', '--rules-target', $target, + @dpkg_opts); + } + + # Any warnings? + if (@warnings) { + # Don't know why we need this, but seems that we do, otherwise, + # the warnings get muddled up with the other output. + IO::Handle::flush(\*STDOUT); + + my $warns = @warnings > 1 ? "S" : ""; + warn "\nWARNING$warns generated by $progname:\n" + . join("\n", @warnings) . "\n"; + } +} else { + if ($run_lintian && system('command -v lintian >/dev/null 2>&1') == 0) { + $lintian_exists = 1; + } + # We'll need to be a bit cleverer to determine the changes file name; + # see below + $build = "${pkg}_${sversion}_${arch}.build"; + $changes = "${pkg}_${sversion}_${arch}.changes"; + open BUILD, "| tee ../$build" or fatal "couldn't open pipe to tee: $!"; + $logging = 1; + close STDOUT; + close STDERR; + open STDOUT, ">&BUILD" or fatal "can't reopen stdout: $!"; + open STDERR, ">&BUILD" or fatal "can't reopen stderr: $!"; + + system_withecho('dpkg-buildpackage', @dpkg_opts); + + chdir '..' or fatal "can't chdir: $!"; + + open CHANGES, '<', $changes or fatal "can't open $changes for reading: $!"; + my @changefilecontents = <CHANGES>; + close CHANGES; + + # check Ubuntu merge Policy: When merging with Debian, -v must be used + # and the remaining changes described + my $ch = join "\n", @changefilecontents; + if ( $sourceonly + && $version =~ /ubuntu1$/ + && $ENV{'DEBEMAIL'} =~ /ubuntu/ + && $ch =~ /(merge|sync).*Debian/i) { + push(@warnings, +"Ubuntu merge policy: when merging Ubuntu packages with Debian, -v must be used" + ) unless $since; + push(@warnings, +"Ubuntu merge policy: when merging Ubuntu packages with Debian, changelog must describe the remaining Ubuntu changes" + ) + unless $ch + =~ /Changes:.*(remaining|Ubuntu)(.|\n )*(differen|changes)/is; + } + + run_hook('lintian', $run_lintian && $lintian_exists); + + if ($run_lintian && $lintian_exists) { + $< = $> = $uid; # Give up on root privileges if we can + $( = $) = $gid; + my @lintian + = ('lintian', @lintian_extra_opts, @lintian_opts, $changes); + print "Now running @lintian ...\n"; + system(@lintian); + print "Finished running lintian.\n"; + } + + # They've insisted. Who knows why?! + if (($signchanges or $signsource) and $usepause) { + print "Press the return key to start signing process\n"; + <STDIN>; + } + + run_hook('signing', ($signchanges || (!$sourceonly and $signsource))); + + if ($signchanges) { + foreach my $var (keys %store_vars) { + $ENV{$var} = $store_vars{$var}; + } + print "Now signing changes and any dsc files...\n"; + if ($username) { + system('debrsign', @debsign_opts, $username, $changes) == 0 + or fatal "running debrsign failed"; + } else { + system('debsign', @debsign_opts, $changes) == 0 + or fatal "running debsign failed"; + } + } elsif (!$sourceonly and $signsource) { + print "Now signing dsc file...\n"; + if ($username) { + system('debrsign', @debsign_opts, $username, $dsc) == 0 + or fatal "running debrsign failed"; + } else { + system('debsign', @debsign_opts, $dsc) == 0 + or fatal "running debsign failed"; + } + } + + run_hook('post-dpkg-buildpackage', 1); + + # Any warnings? + if (@warnings) { + # Don't know why we need this, but seems that we do, otherwise, + # the warnings get muddled up with the other output. + IO::Handle::flush(\*STDOUT); + + my $warns = @warnings > 1 ? "S" : ""; + warn "\nWARNING$warns generated by $progname:\n" + . join("\n", @warnings) . "\n"; + } + # close the logging process + close STDOUT; + close STDERR; + close BUILD; + open STDOUT, ">&", \*OLDOUT; + open STDERR, ">&", \*OLDERR; +} +exit 0; + +###### Subroutines + +sub setDebuildHook() { + my ($name, $val) = @_; + + unless (grep /^$name$/, @hooks) { + fatal + "unknown hook $name,\nrun $progname --help for usage information"; + } + + if ($externalHook{$name} && $dpkgHook{$name} && $val) { + $hook{$name} = 'cd ..; ' . $val; + } else { + $hook{$name} = $val; + } +} + +sub setDpkgHook() { + my ($name, $val) = @_; + + unless (grep /^$name$/, @hooks) { + fatal + "unknown hook $name,\nrun $progname --help for usage information"; + } + + if ($externalHook{$name} && !$dpkgHook{$name} && $val) { + $hook{$name} = 'cd ..; ' . $val; + } else { + $hook{$name} = $val; + } +} + +sub system_withecho(@) { + print STDERR " ", join(" ", @_), "\n"; + system(@_); + if ($? >> 8) { + fatal "@_ failed"; + } +} + +sub run_hook ($$) { + my ($hook, $act) = @_; + return unless $hook{$hook}; + + print STDERR " Running $hook-hook\n"; + my $hookcmd = $hook{$hook}; + $act = $act ? 1 : 0; + my %per = ( + "%" => "%", + "p" => $pkg, + "v" => $version, + "s" => $sversion, + "u" => $uversion, + "a" => $act + ); + $hookcmd =~ s/\%(.)/exists $per{$1} ? $per{$1} : + (warn ("Unrecognised \% substitution in hook: \%$1\n"), "\%$1")/eg; + + system_withecho($hookcmd); + + if ($? >> 8) { + warn "$progname: $hook-hook failed\n"; + exit($? >> 8); + } +} + +sub fatal($) { + my ($pack, $file, $line); + ($pack, $file, $line) = caller(); + (my $msg = "$progname: fatal error at line $line:\n@_\n") =~ tr/\0//d; + $msg =~ s/\n\n$/\n/; + # redirect stderr before we die... + if ($logging) { + close STDOUT; + close STDERR; + close BUILD; + open STDOUT, ">&", \*OLDOUT; + open STDERR, ">&", \*OLDERR; + } + die $msg; +} |