diff options
Diffstat (limited to 'lib')
46 files changed, 18433 insertions, 0 deletions
diff --git a/lib/Buildd.pm b/lib/Buildd.pm new file mode 100644 index 0000000..9b90e07 --- /dev/null +++ b/lib/Buildd.pm @@ -0,0 +1,192 @@ +#! /usr/bin/perl +# +# Buildd.pm: library for buildd and friends +# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de> +# Copyright © 2005 Ryan Murray <rmurray@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Buildd; + +use strict; +use warnings; +use POSIX; +use FileHandle; +use Sbuild::LogBase; + +require Exporter; +@Buildd::ISA = qw(Exporter); + +@Buildd::EXPORT = qw(unset_env lock_file unlock_file send_mail + ll_send_mail exitstatus isin); + +$Buildd::lock_interval = 15; +$Buildd::max_lock_trys = 120; +($Buildd::progname = $0) =~ s,.*/,,; +my @pwinfo = getpwuid($>); +$Buildd::username = $pwinfo[0]; +$Buildd::gecos = $pwinfo[6]; +$Buildd::gecos =~ s/,.*$//; +$Buildd::hostname = `/bin/hostname -f`; +$Buildd::hostname =~ /^(\S+)$/; $Buildd::hostname = $1; # untaint + +sub isin ($@); +sub unset_env (); +sub lock_file ($;$); +sub unlock_file ($); +sub send_mail ($$$;$); +sub ll_send_mail ($$); +sub exitstatus ($); + +sub isin ($@) { + my $val = shift; + return grep( $_ eq $val, @_ ); +} + +sub unset_env () { + # unset any locale variables (sorted to match output from locale(1)) + delete $ENV{'LANG'}; + delete $ENV{'LANGUAGE'}; + delete $ENV{'LC_CTYPE'}; + delete $ENV{'LC_NUMERIC'}; + delete $ENV{'LC_TIME'}; + delete $ENV{'LC_COLLATE'}; + delete $ENV{'LC_MONETARY'}; + delete $ENV{'LC_MESSAGES'}; + delete $ENV{'LC_PAPER'}; + delete $ENV{'LC_NAME'}; + delete $ENV{'LC_ADDRESS'}; + delete $ENV{'LC_TELEPHONE'}; + delete $ENV{'LC_MEASUREMENT'}; + delete $ENV{'LC_IDENTIFICATION'}; + delete $ENV{'LC_ALL'}; + # other unneeded variables that might be set + delete $ENV{'DISPLAY'}; + delete $ENV{'TERM'}; + delete $ENV{'XDG_RUNTIME_DIR'}; + delete $ENV{'XDG_SEAT'}; + delete $ENV{'XDG_SESSION_COOKIE'}; + delete $ENV{'XDG_SESSION_ID'}; + delete $ENV{'XDG_VTNR'}; +} + +sub lock_file ($;$) { + my $file = shift; + my $nowait = shift; + my $lockfile = "$file.lock"; + my $try = 0; + my $username = (getpwuid($<))[0] || $ENV{'LOGNAME'} || $ENV{'USER'}; + + if (!defined($nowait)) { + $nowait = 0; + } + + repeat: + if (!sysopen( F, $lockfile, O_WRONLY|O_CREAT|O_TRUNC|O_EXCL, 0644 )){ + if ($! == EEXIST) { + # lock file exists, wait + goto repeat if !open( F, "<$lockfile" ); + my $line = <F>; + close( F ); + # If this goes wrong it would be a spinlock and the world will + # end. + goto repeat if !defined( $line ); + if ($line !~ /^(\d+)\s+([\w\d.-]+)$/) { + warn "Bad lock file contents ($lockfile) -- still trying\n"; + } + else { + my($pid, $user) = ($1, $2); + my $cnt = kill( 0, $pid ); + if ($cnt == 0 && $! == ESRCH) { + # process doesn't exist anymore, remove stale lock + warn "Removing stale lock file $lockfile ". + " (pid $pid, user $user)\n"; + unlink( $lockfile ); + goto repeat; + } elsif ($cnt >= 1 and $nowait == 1) { + # process exists. + return 0; + } + } + if (++$try > $Buildd::max_lock_trys) { + warn "Lockfile $lockfile still present after ". + "$Buildd::max_lock_trys * $Buildd::lock_interval ". + " seconds -- giving up\n"; + return 0; + } + sleep $Buildd::lock_interval; + goto repeat; + } + die "$Buildd::progname: Can't create lock file $lockfile: $!\n"; + } + F->print("$$ $username\n"); + F->close(); + return 1; +} + +sub unlock_file ($) { + my $file = shift; + my $lockfile = "$file.lock"; + + unlink( $lockfile ); +} + + +sub send_mail ($$$;$) { + my $addr = shift; + my $subject = shift; + my $text = shift; + my $add_headers = shift; + + return ll_send_mail( $addr, + "To: $addr\n". + "Subject: $subject\n". + "From: $Buildd::gecos ". + "<$Buildd::username\@$Buildd::hostname>\n". + ($add_headers ? $add_headers : ""). + "\n$text\n" ); +} + +sub ll_send_mail ($$) { + my $to = shift; + my $text = shift; + local( *MAIL ); + + # TODO: Don't log to STDERR: Implement as class method using + # standard pipe interface using normal log streams. + + $text =~ s/^\.$/../mg; + local $SIG{'PIPE'} = 'IGNORE'; + if (!open( MAIL, "|/usr/sbin/sendmail -oem '$to'" )) { + print STDERR "Could not open pipe to /usr/sbin/sendmail: $!\n"; + return 0; + } + print MAIL $text; + if (!close( MAIL )) { + print STDERR "sendmail failed (exit status ", exitstatus($?), ")\n"; + return 0; + } + return 1; +} + +sub exitstatus ($) { + my $stat = shift; + + return ($stat >> 8) . "/" . ($stat % 256); +} + +1; diff --git a/lib/Buildd/Base.pm b/lib/Buildd/Base.pm new file mode 100644 index 0000000..c7240c0 --- /dev/null +++ b/lib/Buildd/Base.pm @@ -0,0 +1,190 @@ +# Buildd common base functionality +# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de> +# Copyright © 2009 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Buildd::Base; + +use strict; +use warnings; + +use IO::File; +use Buildd qw(lock_file unlock_file); +use Buildd::Client qw(); + +use Sbuild::Base; +use Sbuild qw($devnull); + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::Base); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + + my $self = $class->SUPER::new($conf); + bless($self, $class); + + $self->set('PID', $$); + + $self->open_log(); + + return $self; +} + +sub open_log ($) { + my $self = shift; + + my $logfile = $self->get_conf('DAEMON_LOG_FILE'); + + my $log = IO::File->new("$logfile", O_CREAT|O_WRONLY|O_APPEND, 0640) + or die "$0: Cannot open logfile $logfile: $!\n"; + $log->autoflush(1); + + # Since we are a daemon, fully detach from terminal by reopening + # stdout and stderr to redirect to the log file. Note messages + # should be printed using log(), not printing directly to the + # filehandle. This is a fallback only. + open(STDOUT, '>&', $log) or warn "Can't redirect stderr\n"; + open(STDERR, '>&', $log) or warn "Can't redirect stderr\n"; + + $self->set('Log Stream', $log); + + return $log; +} + +sub close_log ($) { + my $self = shift; + + # We can't close stdout and stderr, so redirect to /dev/null. + open(STDOUT, '>&', $devnull) or warn "Can't redirect stderr\n"; + open(STDERR, '>&', $devnull) or warn "Can't redirect stderr\n"; + + my $log = $self->get('Log Stream'); + $self->set('Log Stream', undef); + + return $log->close(); +} + +sub reopen_log ($) { + my $self = shift; + + my $log = $self->get('Log Stream'); + + if ($self->close_log()) { + $log = $self->open_log(); + } + + return $log; +} + +sub write_stats ($$$) { + my $self = shift; + my ($cat, $val) = @_; + + local( *F ); + + my $home = $self->get_conf('HOME'); + + lock_file( "$home/stats" ); + open( F, ">>$home/stats/$cat" ); + print F "$val\n"; + close( F ); + unlock_file( "$home/stats" ); +} + +sub get_db_handle ($$) { + my $self = shift; + my $dist_config = shift; + + my $db = Buildd::Client->new($dist_config); + $db->set('Log Stream', $self->get('Log Stream')); + return $db; +} + +sub get_dist_config_by_name ($$) { + my $self = shift; + my $dist_name = shift; + + my $dist_config; + for my $dist_config_entry (@{$self->get_conf('DISTRIBUTIONS')}) { + if ($dist_config_entry->get('DIST_NAME') eq $dist_name) { + $dist_config = $dist_config_entry; + } + } + + if (!$dist_config) { + $self->set('Mail Short Error', + $self->get('Mail Short Error') . + "No configuration found for dist $dist_name\n"); + $self->set('Mail Error', + $self->get('Mail Error') . + "Answer could not be processed, as dist=$dist_name does not match any of\n". + "the entries in the buildd configuration.\n"); + } + + return $dist_config; +} + +sub get_arch_dist_config_by_name ($$) { + my $self = shift; + my $arch_name = shift; + my $dist_name = shift; + + my $arch_config, my $dist_config; + for my $dist_config_entry (@{$self->get_conf('DISTRIBUTIONS')}) { + if ($dist_config_entry->get('BUILT_ARCHITECTURE') eq $arch_name && + $dist_config_entry->get('DIST_NAME') eq $dist_name) { + $dist_config = $dist_config_entry; + } + } + + if (!$dist_config) { + $self->set('Mail Short Error', + $self->get('Mail Short Error') . + "No configuration found for arch=$arch_name, dist=$dist_name\n"); + $self->set('Mail Error', + $self->get('Mail Error') . + "Answer could not be processed, as arch=$arch_name, dist=$dist_name". + "does not match any of the entries in the buildd configuration.\n"); + } + + return $dist_config; +} + +sub log { + my $self = shift; + + my $timestamp = localtime; + # omit weekday and year for brevity + $timestamp =~ s/^\w+\s(.*)\s\d+$/$1/; + my $prefix = "$timestamp $Buildd::progname\[" . + $self->get('PID') . "\]: "; + + for my $line (split(/\n/, join("", @_))) { + Sbuild::Base::log($self, $prefix, $line, "\n"); + } +} + +1; diff --git a/lib/Buildd/Client.pm b/lib/Buildd/Client.pm new file mode 100644 index 0000000..14a9104 --- /dev/null +++ b/lib/Buildd/Client.pm @@ -0,0 +1,135 @@ +# +# Client.pm: client library for wanna-build +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2005-2009 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Buildd::Client; + +use strict; +use warnings; + +use Sbuild qw($devnull); +use Sbuild::ChrootRoot; +use Cwd; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::Base); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + + my $self = $class->SUPER::new($conf); + bless($self, $class); + + $self->set('SETUP', 0); + + return $self; +} + +sub setup { + my $self = shift; + + if (!$self->get('SETUP')) { + my $host = Sbuild::ChrootRoot->new($self->get('Config')); + $host->begin_session(); + $host->set('Log Stream', $self->get('Log Stream')); + $self->set('Host', $host); + $self->set('SETUP', 1); + } +} + +sub get_query { + my $self = shift; + + my @command = (@{$self->get_conf('WANNA_BUILD_SSH_CMD')}, 'wanna-build'); + if ($self->get_conf('WANNA_BUILD_DB_NAME')) { + push(@command, "--database=" . $self->get_conf('WANNA_BUILD_DB_NAME')); + } else { + if ($self->get_conf('BUILT_ARCHITECTURE')) { + push(@command, "--arch=" . $self->get_conf('BUILT_ARCHITECTURE')); + } + if ($self->get_conf('DIST_NAME')) { + push(@command, "--dist=" . $self->get_conf('DIST_NAME')); + } + } + push(@command, "--user=" . $self->get_conf('WANNA_BUILD_DB_USER')) + if $self->get_conf('WANNA_BUILD_DB_USER'); + push(@command, @_); + + return @command; +} + +sub run_query { + my $self = shift; + + my @command = $self->get_query(@_); + + $self->setup(); + + my $pipe = $self->get('Host')->run_command( + { COMMAND => [@command], + USER => $self->get_conf('USERNAME'), + PRIORITY => 0, + }); +} + +sub pipe_query { + my $self = shift; + + my @command = $self->get_query(@_); + + $self->setup(); + + my $pipe = $self->get('Host')->pipe_command( + { COMMAND => [@command], + USER => $self->get_conf('USERNAME'), + PRIORITY => 0, + DIR => getcwd(), + STREAMERR => \*STDOUT, + }); + + return $pipe; +} + +sub pipe_query_out { + my $self = shift; + + my @command = $self->get_query(@_); + + $self->setup(); + + my $pipe = $self->get('Host')->pipe_command( + { COMMAND => [@command], + USER => $self->get_conf('USERNAME'), + PIPE => 'out', + STREAMOUT => $devnull, + PRIORITY => 0, + }); + + return $pipe; +} + +1; diff --git a/lib/Buildd/ClientConf.pm b/lib/Buildd/ClientConf.pm new file mode 100644 index 0000000..e38eb7c --- /dev/null +++ b/lib/Buildd/ClientConf.pm @@ -0,0 +1,177 @@ +# +# ClientConf.pm: configuration library for wanna-build clients +# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de> +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2006-2009 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Buildd::ClientConf; + +use strict; +use warnings; + +use Sbuild::Sysconfig; +use File::Spec; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter); + + @EXPORT = qw(setup); +} + +sub setup ($) { + my $conf = shift; + + my $validate_program = sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + my $program = $conf->get($key); + + die "$key binary is not defined" + if !defined($program) || !$program; + + # Emulate execvp behaviour by searching the binary in the PATH. + my @paths = split(/:/, $ENV{'PATH'}); + # Also consider the empty path for absolute locations. + push (@paths, ''); + my $found = 0; + foreach my $path (@paths) { + $found = 1 if (-x File::Spec->catfile($path, $program)); + } + + die "$key binary '$program' does not exist or is not executable" + if !$found; + }; + + my $validate_ssh = sub { + my $conf = shift; + my $entry = shift; + +# TODO: Provide self, config and entry contexts, which functions to +# get at needed data. Provide generic configuration functions. +# + $validate_program->($conf, $conf->{'KEYS'}->{'SSH'}); + + my $ssh = $conf->get('SSH'); + my $sshuser = $conf->get('WANNA_BUILD_SSH_USER'); + my $sshhost = $conf->get('WANNA_BUILD_SSH_HOST'); + my @sshoptions = @{$conf->get('WANNA_BUILD_SSH_OPTIONS')}; + my $sshsocket = $conf->get('WANNA_BUILD_SSH_SOCKET'); + + my @command = (); + + if ($sshhost) { + push (@command, $ssh); + push (@command, '-l', $sshuser) if $sshuser; + push (@command, '-S', $sshsocket) if $sshsocket; + push (@command, @sshoptions) if @sshoptions; + push (@command, $sshhost); + } + + $conf->set('WANNA_BUILD_SSH_CMD', \@command); + }; + + our $HOME = $conf->get('HOME'); + my $arch = $conf->get('ARCH'); + + my %db_keys = ( + 'SSH' => { + TYPE => 'STRING', + VARNAME => 'ssh', + GROUP => 'Programs', + DEFAULT => 'ssh', + CHECK => $validate_ssh, + HELP => 'Path to ssh binary' + }, + 'WANNA_BUILD_SSH_CMD' => { + TYPE => 'STRING', + GROUP => '__INTERNAL', + DEFAULT => '', + HELP => 'Command to run wanna-build (set automatically from the other wanna-build options)' + }, + 'WANNA_BUILD_SSH_USER' => { + TYPE => 'STRING', + VARNAME => 'wanna_build_ssh_user', + GROUP => 'wanna-build client', + DEFAULT => '', + CHECK => $validate_ssh, + HELP => 'Username for SSH connection' + }, + 'WANNA_BUILD_SSH_HOST' => { + TYPE => 'STRING', + VARNAME => 'wanna_build_ssh_host', + GROUP => 'wanna-build client', + DEFAULT => '', + CHECK => $validate_ssh, + HELP => 'Host for SSH connection' + }, + 'WANNA_BUILD_SSH_SOCKET' => { + TYPE => 'STRING', + VARNAME => 'wanna_build_ssh_socket', + GROUP => 'wanna-build client', + DEFAULT => '', + CHECK => $validate_ssh, + HELP => 'Socket for SSH connection' + }, + 'WANNA_BUILD_SSH_OPTIONS' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'wanna_build_ssh_options', + GROUP => 'wanna-build client', + DEFAULT => [], + CHECK => $validate_ssh, + HELP => 'SSH options. Note this is an array reference.' + }, + 'WANNA_BUILD_DB_NAME' => { + TYPE => 'STRING', + VARNAME => 'wanna_build_db_name', + GROUP => 'wanna-build client', + DEFAULT => undef, + HELP => 'Database name' + }, + 'WANNA_BUILD_DB_USER' => { + TYPE => 'STRING', + VARNAME => 'wanna_build_db_user', + GROUP => 'wanna-build client', + DEFAULT => $conf->get('USERNAME'), + # arch:all packages must not differ depending on which user is + # building the source package, so don't show the default for + # example config and man page generation + IGNORE_DEFAULT => 1, + HELP => 'Database user' + }, + 'BUILT_ARCHITECTURE' => { + TYPE => 'STRING', + VARNAME => 'wanna_build_built_architecture', + GROUP => 'wanna-build client', + DEFAULT => $arch, + # the $native_arch is different depending on the machine where + # sbuild is built but arch:all packages must not differ depending on + # the architecture they are built on, so don't show the default for + # example config and man page generation + IGNORE_DEFAULT => 1, + HELP => 'Architecture for database' + }); + + $conf->set_allowed_keys(\%db_keys); +} + +1; diff --git a/lib/Buildd/Conf.pm b/lib/Buildd/Conf.pm new file mode 100644 index 0000000..3dca902 --- /dev/null +++ b/lib/Buildd/Conf.pm @@ -0,0 +1,628 @@ +# +# Conf.pm: configuration library for buildd +# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de> +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2006-2009 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Buildd::Conf; + +use strict; +use warnings; + +use Buildd::DistConf qw(); +use Buildd::UploadQueueConf qw(); +use Sbuild::ConfBase; +use Sbuild::Sysconfig; +use Buildd::ClientConf qw(); + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter); + + @EXPORT = qw($reread_config new setup read); +} + +our $reread_config = 0; + +sub setup ($); +sub read ($); + +sub new { + my $conf = Sbuild::ConfBase->new(@_); + Buildd::Conf::setup($conf); + Buildd::Conf::read($conf); + + return $conf; +} + +sub setup ($) { + my $conf = shift; + + my $validate_program = sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + my $program = $conf->get($key); + + die "$key binary is not defined" + if !defined($program) || !$program; + + # Emulate execvp behaviour by searching the binary in the PATH. + my @paths = split(/:/, $conf->get('PATH')); + # Also consider the empty path for absolute locations. + push (@paths, ''); + my $found = 0; + foreach my $path (@paths) { + $found = 1 if (-x File::Spec->catfile($path, $program)); + } + + die "$key binary '$program' does not exist or is not executable" + if !$found; + }; + + my $validate_directory = sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + my $directory = $conf->get($key); + + die "$key directory is not defined" + if !defined($directory) || !$directory; + + die "$key directory '$directory' does not exist" + if !-d $directory; + }; + + our $HOME = $conf->get('HOME'); + $main::HOME = $HOME; # TODO: Remove once Buildd.pm uses $conf + my $arch = $conf->get('ARCH'); + + my %buildd_keys = ( + 'ADMIN_MAIL' => { + TYPE => 'STRING', + VARNAME => 'admin_mail', + GROUP => 'Mail', + DEFAULT => 'root', + HELP => 'email address for admin' + }, + 'APT_GET' => { + TYPE => 'STRING', + VARNAME => 'apt_get', + GROUP => 'Programs', + CHECK => $validate_program, + DEFAULT => 'apt-get', + HELP => 'Path to apt-get binary' + }, + 'DPKG_FILE_SUFFIX' => { + TYPE => 'STRING', + VARNAME => 'dpkg_file_suffix', + GROUP => 'Programs', + DEFAULT => '', + HELP => 'Value for the sbuild dpkg-file-suffix option, to be passed on to sbuild', + }, + 'BUILD_LOG_KEEP' => { + TYPE => 'NUMERIC', + VARNAME => 'build_log_keep', + GROUP => 'Watcher', + DEFAULT => 2, + HELP => 'Number of days until build logs are archived' + }, + 'DAEMON_LOG_FILE' => { + TYPE => 'STRING', + VARNAME => 'daemon_log_file', + GROUP => 'Daemon', + IGNORE_DEFAULT => 1, # Don't dump the current home + DEFAULT => "$HOME/daemon.log", + HELP => 'Main buildd daemon log file' + }, + 'DAEMON_LOG_KEEP' => { + TYPE => 'NUMERIC', + VARNAME => 'daemon_log_keep', + GROUP => 'Watcher', + DEFAULT => 7, + HELP => 'Number of days until old daemon logs are archived in a .tar.gz file' + }, + 'DAEMON_LOG_ROTATE' => { + TYPE => 'NUMERIC', + VARNAME => 'daemon_log_rotate', + GROUP => 'Watcher', + DEFAULT => 1, + HELP => 'Number how many days until daemon logs are rotated (one is kept as daemon.log.old, others are moved to old-logs and gzipped)' + }, + 'DAEMON_LOG_SEND' => { + TYPE => 'BOOL', + VARNAME => 'daemon_log_send', + GROUP => 'Watcher', + DEFAULT => 1, + HELP => 'email rotated daemon logs to the admin?' + }, + 'DELAY_AFTER_GIVE_BACK' => { + TYPE => 'NUMERIC', + VARNAME => 'delay_after_give_back', + GROUP => 'Daemon', + DEFAULT => 8 * 60, # 8 hours + HELP => 'Time to avoid packages that have automatically been given back by sbuild (in minutes)' + }, + 'ERROR_MAIL_WINDOW' => { + TYPE => 'NUMERIC', + VARNAME => 'error_mail_window', + GROUP => 'Mail', + DEFAULT => 8*60*60, + HELP => 'If more than five error mails are received within the specified time (in seconds), do not forward (to avoid possible mail loops)' + }, + 'IDLE_SLEEP_TIME' => { + TYPE => 'NUMERIC', + VARNAME => 'idle_sleep_time', + GROUP => 'Daemon', + DEFAULT => 5*60, + HELP => 'Time to sleep when idle (in seconds) between wanna-build --list=needs-build calls)' + }, + 'LOG_QUEUED_MESSAGES' => { + TYPE => 'BOOL', + VARNAME => 'log_queued_messages', + GROUP => 'Mail', + DEFAULT => 0, + HELP => 'Log success messages from upload queue daemon?' + }, + 'MAX_SBUILD_FAILS' => { + TYPE => 'NUMERIC', + VARNAME => 'max_sbuild_fails', + GROUP => 'Daemon', + DEFAULT => 2, + HELP => 'Maximum number of times sbuild can fail before sleeping' + }, + 'MIN_FREE_SPACE' => { + TYPE => 'NUMERIC', + VARNAME => 'min_free_space', + GROUP => 'Daemon', + DEFAULT => 50*1024, + HELP => 'Minimum free space (in KiB) on build filesystem' + }, + 'NICE_LEVEL' => { + TYPE => 'NUMERIC', + VARNAME => 'nice_level', + GROUP => 'Build options', + DEFAULT => 10, + HELP => 'Nice level to run sbuild. Dedicated build daemons should not be niced.' + }, + 'NO_DETACH' => { + TYPE => 'BOOL', + VARNAME => 'no_detach', + GROUP => 'Daemon', + DEFAULT => 0, + HELP => 'Disable becoming a daemon, for debugging purposes. Set to 1 to stop daemonising, otherwise set to 0 to become a daemon.' + }, + 'NO_WARN_PATTERN' => { + TYPE => 'STRING', + VARNAME => 'no_warn_pattern', + GROUP => 'Watcher', + DEFAULT => '^build/(SKIP|REDO|SBUILD-GIVEN-BACK|buildd\.pid|[^/]*.ssh|chroot-[^/]*|current-[^/]*)$', + HELP => 'Don\'t complain about old files if they match the regexp.' + }, + 'PIDFILE' => { + TYPE => 'STRING', + VARNAME => 'pidfile', + GROUP => 'Daemon', +# Set once running as a system service. +# DEFAULT => "${Sbuild::Sysconfig::paths{'LOCALSTATEDIR'}/run/buildd.pid" + IGNORE_DEFAULT => 1, # Don't dump the current home + DEFAULT => "$HOME/build/buildd.pid", + HELP => 'PID file to identify running daemon.' + }, + 'PKG_LOG_KEEP' => { + TYPE => 'NUMERIC', + VARNAME => 'pkg_log_keep', + GROUP => 'Watcher', + DEFAULT => 7, + HELP => 'Number of days until to package logs are archived' + }, + 'SHOULD_BUILD_MSGS' => { + TYPE => 'BOOL', + VARNAME => 'should_build_msgs', + GROUP => 'Daemon', + DEFAULT => 1, + HELP => 'Should buildd send "Should I build" messages?' + }, + 'STATISTICS_MAIL' => { + TYPE => 'STRING', + VARNAME => 'statistics_mail', + GROUP => 'Watcher', + DEFAULT => 'root', + HELP => 'email address for statistics summaries' + }, + 'STATISTICS_PERIOD' => { + TYPE => 'NUMERIC', + VARNAME => 'statistics_period', + GROUP => 'Watcher', + DEFAULT => 7, + HELP => 'Period for statistic summaries (days)' + }, + 'SUDO' => { + TYPE => 'STRING', + VARNAME => 'sudo', + GROUP => 'Programs', + CHECK => $validate_program, + DEFAULT => 'sudo', + HELP => 'Path to sudo binary' + }, + 'WARNING_AGE' => { + TYPE => 'NUMERIC', + VARNAME => 'warning_age', + GROUP => 'Watcher', + DEFAULT => 7, + HELP => 'Age (in days) after which a warning is issued for files in upload and dirs in build' + }, + 'CONFIG_TIME' => { + TYPE => 'NUMERIC', + VARNAME => 'config_time', + GROUP => '__INTERNAL', + DEFAULT => {}, + HELP => 'Time configuration was last read' + }, + 'DISTRIBUTIONS' => { + TYPE => 'ARRAY:HASH:SCALAR', + VARNAME => 'distributions', + GROUP => 'Build options', + DEFAULT => [], + IGNORE_DEFAULT => 1, # Don't dump class to config + HELP => 'List of distributions that buildd should take packages from', + EXAMPLE => +'$distributions = [ + { + # name of the suite to build (also used to query wanna-build) + dist_name => ["unstable", "testing"], + + # architecture to be built (will be passed to sbuild and can be + # used to compute wanna_build_db_name) + built_architecture => undef, + + # host on which wanna-build is run + wanna_build_ssh_host => "buildd.debian.org", + + # user as who we are going to connect to the host running wanna-build + wanna_build_ssh_user => "buildd_arch", + + # SSH control socket path for ssh -S option + wanna_build_ssh_socket => "", + + # Additional SSH options used when connecting + wanna_build_ssh_options => [], + + # database used for wanna-build + wanna_build_db_name => "arch/build-db", + + # Username to use for wanna-build. + wanna_build_db_user => $Buildd::username, + + # Local queue directory where binaries are stored before uploaded + # by dupload. You need to configure this directory in + # @upload_queues to get packages uploaded from there. + dupload_local_queue_dir => "upload", + + # list of packages which shouldn\'t be picked up by buildd + no_auto_build => [], + + # list of packages which should only be taken if there absolutely + # nothing else to do (probably packages included in no_auto_build + # because they take too long) + weak_no_auto_build => [], + + # regex used to filter out unwanted packages: + #no_build_regex => "^(contrib/|non-free/)?non-US/", + + # regex used to filter packages to build: + #build_regex => "", + + # mail addr of buildd admin handling packages from this distribution + logs_mailed_to => $admin_mail, + + # schroot name (or alias) of the chrooted environment to use for + # building (will be passed to sbuild). sbuild\'s default is + # the first of $distribution-$arch-sbuild, $distribution-sbuild, + # $distribution-$arch and $distribution. + sbuild_chroot => undef, + + } +];' + }, + 'UPLOAD_QUEUES' => { + TYPE => 'ARRAY:HASH:SCALAR', + VARNAME => 'upload_queues', + GROUP => 'Uploader', + DEFAULT => [], + IGNORE_DEFAULT => 1, # Don't dump class to config + HELP => 'Package upload queues', + EXAMPLE => +'$upload_queues = [ + { + # Local queue directory where binaries are stored before uploaded + # by dupload. + dupload_local_queue_dir => "upload", + + # Upload site for buildd-upload to pass to dupload(1); see + # /etc/dupload.conf for possible values. + dupload_archive_name => "anonymous-ftp-master", + }, + + { + # Local queue directory where binaries are stored before uploaded + # by dupload. + dupload_local_queue_dir => "upload-security", + + # Upload site for buildd-upload to pass to dupload(1); see + # /etc/dupload.conf for possible values. + dupload_archive_name => "security", + } +];' + }); + + $conf->set_allowed_keys(\%buildd_keys); + Buildd::ClientConf::setup($conf); +} + +sub read ($) { + my $conf = shift; + + my $HOME = $conf->get('HOME'); + + my $global = $Sbuild::Sysconfig::paths{'BUILDD_CONF'}; + my $user = "$HOME/.builddrc"; + my %config_time = (); + my $user_time = 0; + + my $reread = 0; + + sub ST_MTIME () { 9 } + + my @config_files = ($global, $user); + + $reread = 1 if $reread_config; + + foreach (@config_files) { + if (-r $_) { + $config_time{$_} = 0; + my @stat = stat($_); + if (!defined($conf->get('CONFIG_TIME')->{$_}) || + $conf->get('CONFIG_TIME')->{$_} < $stat[ST_MTIME]) { + $config_time{$_} = $stat[ST_MTIME]; + $reread = 1; + } + } + } + + # For compatibility only. Non-scalars are deprecated. + my $deprecated_init = <<END; +# Variables are undefined, so config will default to DEFAULT if unset. +my \$defaults; +my \@distributions; +undef \@distributions; +my \@upload_queues; +undef \@upload_queues; + +#legacy fields: +my \@weak_no_auto_build; +undef \@weak_no_auto_build; +my \$build_regex = undef; # Should this be user settable? +my \@no_auto_build; +undef \@no_auto_build; +my \$no_build_regex = undef; +my \@take_from_dists; +undef \@take_from_dists; +my \$sshcmd = undef; +my \$sshsocket = undef; +my \$wanna_build_user = undef; +my \$wanna_build_dbbase = undef; +END + + my $deprecated_setup = ''; + + my $custom_setup = <<END; +if (\$sshcmd && \$sshcmd =~ /^\\s*(\\S+)\\s+(.+)/) { + my \$rest = \$2; + \$conf->set('SSH', \$1); + + #Try to pry the user out: + if (\$rest =~ /(-l\\s*(\\S+))\\s+/) { + \$wanna_build_ssh_user = \$2; + #purge this from the rest: + \$rest =~ s/\\Q\$1//; + } elsif (\$rest =~ /\\s+(\\S+)\@/) { + \$wanna_build_ssh_user = \$1; + \$rest =~ s/\\Q\$1\\E\@//; + } + + #Hope that the last argument is the host: + if (\$rest =~ /\\s+(\\S+)\\s*\$/) { + \$wanna_build_ssh_host = \$1; + \$rest =~ s/\\Q\$1//; + } + + #rest should be options: + if (\$rest !~ /\\s*/) { + \$wanna_build_ssh_options = [split \$rest]; + } +} + +if (\$sshsocket) { + \$wanna_build_ssh_socket = \$sshsocket; +} + +if (\$wanna_build_user) { + \$wanna_build_db_user = \$wanna_build_user; +} + +if (\$wanna_build_dbbase) { + \$wanna_build_db_name = \$wanna_build_dbbase; +} + +#Convert old config, if needed: +my \@distributions_info; +if (\@take_from_dists) { + for my \$dist (\@take_from_dists) { + my \%entry; + + \$entry{DIST_NAME} = \$dist; + \$entry{SSH} = \$ssh; + + if (\$dist =~ /security/) { + \$entry{DUPLOAD_LOCAL_QUEUE_DIR} = 'upload-security'; + } + if (\$build_regex) { + \$entry{BUILD_REGEX} = \$build_regex; + } + if (\$no_build_regex) { + \$entry{NO_BUILD_REGEX} = \$build_regex; + } + if (\@no_auto_build) { + \$entry{NO_AUTO_BUILD} = \\\@no_auto_build; + } + if (\@weak_no_auto_build) { + \$entry{WEAK_NO_AUTO_BUILD} = \\\@weak_no_auto_build; + } + + \$entry{WANNA_BUILD_DB_NAME} = \$wanna_build_db_name; + \$entry{WANNA_BUILD_DB_USER} = \$wanna_build_db_user; + \$entry{WANNA_BUILD_SSH_HOST} = \$wanna_build_ssh_host; + \$entry{WANNA_BUILD_SSH_USER} = \$wanna_build_ssh_user; + \$entry{WANNA_BUILD_SSH_SOCKET} = \$wanna_build_ssh_socket; + \$entry{WANNA_BUILD_SSH_OPTIONS} = \$wanna_build_ssh_options; + \$entry{WANNA_BUILD_API} = 0; + + my \$dist_config = Buildd::DistConf::new_hash(CHECK=>$conf->{'CHECK'}, + HASH=>\\\%entry); + + push \@distributions_info, \$dist_config; + } +} else { + my \@dists = (); + push \@dists, \@{\$distributions} if defined \$distributions; + + if (\@distributions) { + warn 'W: \@distributions is deprecated; please use the array reference \$distributions[]\n'; + push \@dists, \@distributions; + } + + for my \$raw_entry (\@dists) { + my \%entry; + my \@dist_names; + + #Find out for which distributions this entry is intended: + for my \$key (keys \%\$raw_entry) { + if (uc(\$key) eq "DIST_NAME") { + if (ref(\$raw_entry->{\$key}) eq "ARRAY") { + push \@dist_names, \@{\$raw_entry->{\$key}}; + } else { + push \@dist_names, \$raw_entry->{\$key}; + } + } + } + + for my \$key (keys \%\$raw_entry) { + if (uc(\$key) ne "DIST_NAME") { + \$entry{uc(\$key)} = \$raw_entry->{\$key}; + } + } + + for my \$key (keys \%\$defaults) { + if (uc(\$key) ne "DIST_NAME" && not defined \$entry{uc(\$key)}) { + \$entry{uc(\$key)} = \$defaults->{\$key}; + } + } + + \$entry{WANNA_BUILD_API} //= 1; + + + #We need this to pass this to Buildd::Client: + \$entry{SSH} = \$ssh; + + #Make one entry per distribution, it's easier later on: + for my \$dist (\@dist_names) { + \$entry{'DIST_NAME'} = \$dist; + my \$dist_config = Buildd::DistConf::new_hash(HASH=>\\\%entry); + push \@distributions_info, \$dist_config; + } + } +} + +\$conf->set('DISTRIBUTIONS', \\\@distributions_info); + +my \@queues = (); +push \@queues, \@{\$upload_queues} if defined \$upload_queues; + +if (\@upload_queues) { + warn 'W: \@upload_queues is deprecated; please use the array reference \$upload_queues[]\n'; + push \@queues, \@upload_queues; +} + +if (\@queues) { + my \@upload_queue_configs; + for my \$raw_entry (\@queues) { + my \%entry; + for my \$key (keys \%\$raw_entry) { + \$entry{uc(\$key)} = \$raw_entry->{\$key}; + } + + my \$queue_config = Buildd::UploadQueueConf::new_hash(CHECK=>$conf->{'CHECK'}, + HASH=>\\\%entry); + + push \@upload_queue_configs, \$queue_config; + } + \$conf->set('UPLOAD_QUEUES', \\\@upload_queue_configs); +} else { + push \@{\$conf->get('UPLOAD_QUEUES')}, + Buildd::UploadQueueConf::new_hash(CHECK=>$conf->{'CHECK'}, + HASH=> + { + DUPLOAD_LOCAL_QUEUE_DIR => 'upload', + DUPLOAD_ARCHIVE_NAME => 'anonymous-ftp-master' + } + ), + Buildd::UploadQueueConf::new_hash(CHECK=>$conf->{'CHECK'}, + HASH=> + { + DUPLOAD_LOCAL_QUEUE_DIR => 'upload-security', + DUPLOAD_ARCHIVE_NAME => 'security' + } + ); +} + +# Set here to allow user to override. +if (-t STDIN && -t STDOUT && \$conf->get('NO_DETACH')) { + \$conf->_set_default('VERBOSE', 1); +} else { + \$conf->_set_default('VERBOSE', 0); +} +END + + $conf->read(\@config_files, $deprecated_init, $deprecated_setup, + $custom_setup); + + # Update times + if ($reread) { + foreach (@config_files) { + if (-r $_) { + $conf->get('CONFIG_TIME')->{$_} = $config_time{$_}; + } + } + } +} + +1; diff --git a/lib/Buildd/Daemon.pm b/lib/Buildd/Daemon.pm new file mode 100644 index 0000000..dc07254 --- /dev/null +++ b/lib/Buildd/Daemon.pm @@ -0,0 +1,998 @@ +# buildd: daemon to automatically build packages +# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de> +# Copyright © 2009 Roger Leigh <rleigh@debian.org> +# Copyright © 2005 Ryan Murray <rmurray@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Buildd::Daemon; + +use strict; +use warnings; + +use POSIX; +use Buildd qw(isin lock_file unlock_file send_mail exitstatus); +use Buildd::Conf qw(); +use Buildd::Base; +use Sbuild qw($devnull df); +use Sbuild::Sysconfig; +use Sbuild::ChrootRoot; +use Buildd::Client; +use Cwd; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Buildd::Base); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + + my $self = $class->SUPER::new($conf); + bless($self, $class); + + $self->set('Daemon', 0); + + return $self; +} + +sub ST_MTIME () { 9 } + +sub run { + my $self = shift; + + my $host = Sbuild::ChrootRoot->new($self->get('Config')); + $host->set('Log Stream', $self->get('Log Stream')); + $self->set('Host', $host); + $host->begin_session() or die "Can't begin session\n"; + + my $my_binary = $0; + $my_binary = cwd . "/" . $my_binary if $my_binary !~ m,^/,; + $self->set('MY_BINARY', $my_binary); + + my @bin_stats = stat( $my_binary ); + die "Cannot stat $my_binary: $!\n" if !@bin_stats; + $self->set('MY_BINARY_TIME', $bin_stats[ST_MTIME]); + + chdir( $self->get_conf('HOME') . "/build" ) + or die "Can't cd to " . $self->get_conf('HOME') . "/build: $!\n"; + + open( STDIN, "</dev/null" ) + or die "$0: can't redirect stdin to /dev/null: $!\n"; + + if (open( PID, "<" . $self->get_conf('PIDFILE') )) { + my $pid = <PID>; + close( PID ); + $pid =~ /^[[:space:]]*(\d+)/; $pid = $1; + if (!$pid || (kill( 0, $pid ) == 0 && $! == ESRCH)) { + warn "Removing stale pid file (process $pid dead)\n"; + } + else { + die "Another buildd (pid $pid) is already running.\n"; + } + } + + if (!@{$self->get_conf('DISTRIBUTIONS')}) { + die "distribution list is empty, aborting."; + } + + if (!$self->get_conf('NO_DETACH')) { + defined(my $pid = fork) or die "can't fork: $!\n"; + exit if $pid; # parent exits + setsid or die "can't start a new session: $!\n"; + } + + $self->set('PID', $$); # Needed for cleanup + $self->set('Daemon', 1); + + open( PID, ">" . $self->get_conf('PIDFILE') ) + or die "can't create " . $self->get_conf('PIDFILE') . ": $!\n"; + printf PID "%5d\n", $self->get('PID'); + close( PID ); + + $self->log("Daemon started. (pid=$$)\n"); + + undef $ENV{'DISPLAY'}; + +# the main loop + MAINLOOP: + while( 1 ) { + $self->check_restart(); + + my ( $dist_config, $pkg_ver) = get_next_REDO($self); + $self->do_build( $dist_config, $pkg_ver) if $pkg_ver; + next MAINLOOP if $pkg_ver; + + ( $dist_config, $pkg_ver) = get_next_WANNABUILD($self); + $self->do_build( $dist_config, $pkg_ver) if $pkg_ver; + next MAINLOOP if $pkg_ver; + + # sleep a little bit if there was nothing to do this time + $self->log("Nothing to do -- sleeping " . + $self->get_conf('IDLE_SLEEP_TIME') . " seconds\n"); + my $idle_start_time = time; + sleep( $self->get_conf('IDLE_SLEEP_TIME') ); + my $idle_end_time = time; + $self->write_stats("idle-time", $idle_end_time - $idle_start_time); + } + + return 0; +} + +sub get_next_WANNABUILD { + my $self = shift; + foreach my $dist_config (@{$self->get_conf('DISTRIBUTIONS')}) { + $self->check_ssh_master($dist_config); + my $dist_name = $dist_config->get('DIST_NAME'); + my %givenback = $self->read_givenback(); + my $db = $self->get_db_handle($dist_config); + my $pipe = $db->pipe_query( + ($dist_config->get('WANNA_BUILD_API') ? '--api '.$dist_config->get('WANNA_BUILD_API') : ''), + '--list=needs-build', + ($dist_config->get('WANNA_BUILD_MIN_AGE') ? '--min-age '.$dist_config->get('WANNA_BUILD_MIN_AGE') : ''), + ); + if (!$pipe) { + $self->log("Can't spawn wanna-build --list=needs-build: $!\n"); + next MAINLOOP; + } + + my($pkg_ver, $total, $nonex, $lowprio_pkg_ver); + while( <$pipe> ) { + my $socket = $dist_config->get('WANNA_BUILD_SSH_SOCKET'); + if ($socket && + (/^Couldn't connect to $socket: Connection refused[\r]?$/ || + /^Control socket connect\($socket\): Connection refused[\r]?$/)) { + unlink($socket); + $self->check_ssh_master($dist_config); + next; + } + elsif (/^Total (\d+) package/) { + $total = $1; + next; + } + elsif (/^Database for \S+ doesn.t exist/) { + $nonex = 1; + } + next if $nonex; + next if defined($pkg_ver); #we only want one! + my @line = (split( /\s+/, $_)); + my $pv = $line[0]; + my $no_build_regex = $dist_config->get('NO_BUILD_REGEX'); + my $build_regex = $dist_config->get('BUILD_REGEX'); + next if $no_build_regex && $pv =~ m,$no_build_regex,; + next if $build_regex && $pv !~ m,$build_regex,; + $pv =~ s,^.*/,,; + my $p; + ($p = $pv) =~ s/_.*$//; + next if isin( $p, @{$dist_config->get('NO_AUTO_BUILD')} ); + next if $givenback{$pv}; + if (isin( $p, @{$dist_config->get('WEAK_NO_AUTO_BUILD')} )) { + # only consider the first lowprio item if there are + # multiple ones + next if defined($lowprio_pkg_ver); + $lowprio_pkg_ver = $pv; + next; + } + $pkg_ver = $pv; + } + close( $pipe ); + next if $nonex; + if ($?) { + $self->log("wanna-build --list=needs-build --dist=${dist_name} failed; status ", + exitstatus($?), "\n"); + next; + } + $self->log("${dist_name}: total $total packages to build.\n") if defined($total); + + # Build weak_no_auto packages before the next dist + if (!defined($pkg_ver) && defined($lowprio_pkg_ver)) { + $pkg_ver = $lowprio_pkg_ver; + } + + next if !defined($pkg_ver); + my $todo = $self->do_wanna_build( $dist_config, $pkg_ver ); + last if !$todo; + return ( $dist_config, $todo ); + } +} + +sub get_next_REDO { + my $self = shift; + my ( $dist_config, $pkg_ver); + foreach my $current_dist_config (@{$self->get_conf('DISTRIBUTIONS')}) { + $pkg_ver = $self->get_from_REDO( $current_dist_config ); + $dist_config = $current_dist_config; + last if defined($pkg_ver); + } + return ( $dist_config, $pkg_ver); +} + + +sub get_from_REDO { + my $self = shift; + my $wanted_dist_config = shift; + my $ret = undef; + local( *F ); + + lock_file( "REDO" ); + goto end if ! -f "REDO"; + if (!open( F, "<REDO" )) { + $self->log("File REDO exists, but can't open it: $!\n"); + goto end; + } + my @lines = <F>; + close( F ); + + $self->block_signals(); + if (!open( F, ">REDO" )) { + $self->log("Can't open REDO for writing: $!\n", + "Raw contents:\n@lines\n"); + goto end; + } + foreach (@lines) { + if (!/^(\S+)\s+(\S+)(?:\s*|\s+(\d+)\s+(\S.*))?$/) { + $self->log("Ignoring/deleting bad line in REDO: $_"); + next; + } + my($pkg, $dist, $binNMUver, $changelog) = ($1, $2, $3, $4); + if ($dist eq $wanted_dist_config->get('DIST_NAME') && !defined($ret)) { + $ret = {'pv' => $pkg }; + if (defined $binNMUver) { + $ret->{'changelog'} = $changelog; + $ret->{'binNMU'} = $binNMUver; + } + } else { + print F $_; + } + } + close( F ); + + end: + unlock_file( "REDO" ); + $self->unblock_signals(); + return $ret; +} + +sub add_given_back ($$) { + my $self = shift; + my $pkg_ver = shift; + + local( *F ); + lock_file("SBUILD-GIVEN-BACK", 0); + + if (open( F, ">>SBUILD-GIVEN-BACK" )) { + print F $pkg_ver . " " . time() . "\n"; + close( F ); + } else { + $self->log("Can't open SBUILD-GIVEN-BACK: $!\n"); + } + + unlock_file("SBUILD-GIVEN-BACK"); +} + +sub read_givenback { + my $self = shift; + + my %gb; + my $now = time; + local( *F ); + + lock_file( "SBUILD-GIVEN-BACK" ); + + if (open( F, "<SBUILD-GIVEN-BACK" )) { + %gb = map { split } <F>; + close( F ); + } + + if (open( F, ">SBUILD-GIVEN-BACK" )) { + foreach (keys %gb) { + if ($now - $gb{$_} > $self->get_conf('DELAY_AFTER_GIVE_BACK') *60) { + delete $gb{$_}; + } + else { + print F "$_ $gb{$_}\n"; + } + } + close( F ); + } + else { + $self->log("Can't open SBUILD-GIVEN-BACK: $!\n"); + } + + unlock: + unlock_file( "SBUILD-GIVEN-BACK" ); + return %gb; +} + +sub do_wanna_build { + my $self = shift; + + my $dist_config = shift; + my $pkgver = shift; + my @output = (); + my $ret = undef; + my $n = 0; + + $self->block_signals(); + + my $db = $self->get_db_handle($dist_config); + if ($dist_config->get('WANNA_BUILD_API') >= 1) { + use YAML::Tiny; + my $pipe = $db->pipe_query( + '--api '.$dist_config->get('WANNA_BUILD_API'), + $pkgver); + unless ($pipe) { + $self->unblock_signals(); + $self->log("Can't spawn wanna-build: $!\n"); + return undef; + } + local $/ = undef; + my $yaml = <$pipe>; + $yaml =~ s,^update transactions:.*$,,m; # get rid of simulate output in case simulate is specified above + $self->log($yaml); + $yaml = YAML::Tiny->read_string($yaml); + $yaml = $yaml->[0]; + foreach my $pkgv (@$yaml) { + my $pkg = (keys %$pkgv)[0]; + my $pkgd; + foreach my $k (@{$pkgv->{$pkg}}) { + foreach my $l (keys %$k) { + $pkgd->{$l} = $k->{$l}; + } + }; + if ($pkgd->{'status'} ne 'ok') { + $self->log("Can't take $pkg: $pkgd->{'status'}\n"); + next; + } + $ret = { 'pv' => $pkgver }; + # fix SHOULD_BUILD_MSGS +# if ($self->get_conf('SHOULD_BUILD_MSGS')) { +# $self->handle_prevfailed( $dist_config, grep( /^\Q$pkg\E_/, @_ ) ); +# } else { +# push( @output, grep( /^\Q$pkg\E_/, @_ ) ); + my $fields = { 'changelog' => 'extra-changelog', + 'binNMU' => 'binNMU', + 'extra-depends' => 'extra-depends', + 'extra-conflicts' => 'extra-conflicts', + 'build_dep_resolver' => 'build_dep_resolver', + 'arch_all' => 'arch_all', + 'mail_logs' => 'mail_logs', + }; + for my $f (keys %$fields) { + $ret->{$f} = $pkgd->{$fields->{$f}} if $pkgd->{$fields->{$f}}; + } + last; + } + close( $pipe ); + $self->unblock_signals(); + $self->write_stats("taken", $n) if $n; + return $ret; + } + my $pipe = $db->pipe_query( + '-v', + $pkgver); + if ($pipe) { + while( <$pipe> ) { + next if /^wanna-build Revision/; + if (/^(\S+):\s*ok/) { + $ret = { 'pv' => $pkgver }; + ++$n; + } + elsif (/^(\S+):.*NOT OK/) { + my $pkg = $1; + my $nextline = <$pipe>; + chomp( $nextline ); + $nextline =~ s/^\s+//; + $self->log("Can't take $pkg: $nextline\n"); + } + elsif (/^(\S+):.*previous version failed/i) { + my $pkg = $1; + ++$n; + if ($self->get_conf('SHOULD_BUILD_MSGS')) { + $self->handle_prevfailed( $dist_config, $pkgver ); + } else { + $ret = { 'pv' => $pkgver }; + } + # skip until ok line + while( <$pipe> ) { + last if /^\Q$pkg\E:\s*ok/; + } + } + elsif (/^(\S+):.*needs binary NMU (\d+)/) { + my $pkg = $1; + my $binNMUver = $2; + chop (my $changelog = <$pipe>); + my $newpkg; + ++$n; + + push( @output, grep( /^\Q$pkg\E_/, @_ ) ); + $ret = { 'pv' => $pkgver }; + $ret->{'changelog'} = $changelog; + $ret->{'binNMU'} = $binNMUver; + # skip until ok line + while( <$pipe> ) { + last if /^\Q$pkg\E:\s*aok/; + } + } + } + close( $pipe ); + $self->unblock_signals(); + $self->write_stats("taken", $n) if $n; + return $ret; + } + else { + $self->unblock_signals(); + $self->log("Can't spawn wanna-build: $!\n"); + return undef; + } +} + +sub should_skip { + my $self = shift; + my $pkgv = shift; + + my $found = 0; + + $self->lock_file("SKIP", 0); + goto unlock if !open( F, "SKIP" ); + my @pkgs = <F>; + close(F); + + if (!open( F, ">SKIP" )) { + $self->log("Can't open SKIP for writing: $!\n", + "Would write: @pkgs\nminus $pkgv\n"); + goto unlock; + } + foreach (@pkgs) { + if (/^\Q$pkgv\E$/) { + ++$found; + $self->log("$pkgv found in SKIP file -- skipping building it\n"); + } + else { + print F $_; + } + } + close( F ); + unlock: + $self->unlock_file("SKIP"); + return $found; +} + +sub do_build { + my $self = shift; + my $dist_config = shift; + my $todo = shift; + # $todo = { 'pv' => $pkg_ver, 'changelog' => $binNMUlog->{$pkg_ver}, 'binNMU' => $binNMUver; }; + + # If the package to build is in SKIP, then skip. + if ($self->should_skip($todo->{'pv'})) { + return; + } + + my $free_space; + + while (($free_space = df(".")) < $self->get_conf('MIN_FREE_SPACE')) { + $self->log("Delaying build, because free space is low ($free_space KB)\n"); + my $idle_start_time = time; + sleep( 10*60 ); + my $idle_end_time = time; + $self->write_stats("idle-time", $idle_end_time - $idle_start_time); + } + + $self->log("Starting build (dist=" . $dist_config->get('DIST_NAME') . ") of " + .($todo->{'binNMU'} ? "!".$todo->{'binNMU'}."!" : "") + ."$todo->{'pv'}\n"); + $self->write_stats("builds", 1); + + my @sbuild_args = (); + if ($self->get_conf('NICE_LEVEL') != 0) { + @sbuild_args = ( 'nice', '-n', $self->get_conf('NICE_LEVEL') ); + } + + push @sbuild_args, 'sbuild', + '--apt-update', + '--no-apt-upgrade', + '--no-apt-distupgrade', + '--no-run-lintian', + '--batch', + "--stats-dir=" . $self->get_conf('HOME') . "/stats", + "--dist=" . $dist_config->get('DIST_NAME'); + + push @sbuild_args, "--sbuild-mode=buildd"; + push @sbuild_args, "--mailfrom=".$dist_config->get('MAILFROM') if $dist_config->get('MAILFROM'); + push @sbuild_args, "--maintainer=".$dist_config->get('MAINTAINER_NAME') if $dist_config->get('MAINTAINER_NAME'); + push @sbuild_args, "--dpkg-file-suffix=".$self->get_conf('DPKG_FILE_SUFFIX') if $self->get_conf('DPKG_FILE_SUFFIX'); + + if ($dist_config->get('SIGN_WITH')) { + push @sbuild_args, '--keyid=' . $dist_config->get('SIGN_WITH'); + } + + #multi-archive-buildd keeps the mailto configuration in the builddrc, so + #this needs to be passed over to sbuild. If the buildd config doesn't have + #it, we hope that the address is configured in .sbuildrc and the right one: + if ($dist_config->get('LOGS_MAILED_TO')) { + push @sbuild_args, '--mail-log-to=' . $dist_config->get('LOGS_MAILED_TO'); + } elsif ($dist_config->get('LOGS_MAIL_ALSO') || $todo->{'mail_logs'}) { + push @sbuild_args, '--mail-log-to=' . join (',', grep { $_ } ($dist_config->get('LOGS_MAIL_ALSO'), $todo->{'mail_logs'})); + } + #Some distributions (bpo, experimental) require a more complex dep resolver. + #Ask sbuild to use another build-dep resolver if the config says so: + if ($dist_config->get('BUILD_DEP_RESOLVER') || $todo->{'build_dep_resolver'}) { + push @sbuild_args, '--build-dep-resolver=' . ($dist_config->get('BUILD_DEP_RESOLVER') || $todo->{'build_dep_resolver'}); + } + if ($dist_config->get('BUILT_ARCHITECTURE')) { + if ($dist_config->get('BUILT_ARCHITECTURE') eq 'all') { + push ( @sbuild_args, "--arch-all", "--no-arch-any" ); + } else { + push ( @sbuild_args, "--no-arch-all", "--arch-any", "--arch=" . $dist_config->get('BUILT_ARCHITECTURE') ); + } + } + push ( @sbuild_args, "--chroot=" . $dist_config->get('SBUILD_CHROOT') ) + if $dist_config->get('SBUILD_CHROOT'); + + + push ( @sbuild_args, "--binNMU=$todo->{'binNMU'}") if $todo->{'binNMU'}; + push ( @sbuild_args, "--make-binNMU=$todo->{'changelog'}") if $todo->{'changelog'}; + push ( @sbuild_args, "--add-conflicts=$todo->{'extra-conflicts'}") if $todo->{'extra-conflicts'}; + push ( @sbuild_args, "--add-depends=$todo->{'extra-depends'}") if $todo->{'extra-depends'}; + push @sbuild_args, $todo->{'pv'}; + $self->log("command line: @sbuild_args\n"); + + $main::sbuild_pid = open(SBUILD_OUT, "-|"); + + #We're childish, so call sbuild: + if ($main::sbuild_pid == 0) { + { exec (@sbuild_args) }; + $self->log("Cannot execute sbuild: $!\n"); + exit(64); + } + + if (!defined $main::sbuild_pid) { + $self->log("Cannot fork for sbuild: $!\n"); + goto failed; + } + + #We want to collect the first few lines of sbuild output: + my ($sbuild_output_line_count, @sbuild_output_buffer) = (0, ()); + while (<SBUILD_OUT>) { + #5 lines are enough: + if (++$sbuild_output_line_count < 5) { + push @sbuild_output_buffer, $_; + } + } + + #We got enough output, now just wait for sbuild to die: + my $rc; + while (($rc = wait) != $main::sbuild_pid) { + if ($rc == -1) { + last if $! == ECHILD; + next if $! == EINTR; + $self->log("wait for sbuild: $!; continuing to wait\n"); + } elsif ($rc != $main::sbuild_pid) { + $self->log("wait for sbuild: returned unexpected pid $rc\n"); + } + } + my $sbuild_exit_code = $?; + undef $main::sbuild_pid; + close(SBUILD_OUT); + + #Process sbuild's results: + my $db = $self->get_db_handle($dist_config); + my $failed = 1; + my $giveback = 1; + + if (WIFEXITED($sbuild_exit_code)) { + my $status = WEXITSTATUS($sbuild_exit_code); + + if ($status == 0) { + $failed = 0; + $giveback = 0; + $self->log("sbuild of $todo->{'pv'} succeeded -- marking as built in wanna-build\n"); + $db->run_query('--built', '--dist=' . $dist_config->get('DIST_NAME'), $todo->{'pv'}); + + if ($dist_config->get('SIGN_WITH') && $dist_config->get('BUILT_ARCHITECTURE')) { + # XXX: Check if signature is present. + $self->move_to_upload($dist_config, $todo->{'pv'}, $todo->{'binNMU'}); + } + } elsif ($status == 2) { + $giveback = 0; + $self->log("sbuild of $todo->{'pv'} failed with status $status (build failed) -- marking as attempted in wanna-build\n"); + $db->run_query('--attempted', '--dist=' . $dist_config->get('DIST_NAME'), $todo->{'pv'}); + $self->write_stats("failed", 1); + } else { + $self->log("sbuild of $todo->{'pv'} failed with status $status (local problem) -- giving back\n"); + } + } elsif (WIFSIGNALED($sbuild_exit_code)) { + my $sig = WTERMSIG($sbuild_exit_code); + $self->log("sbuild of $todo->{'pv'} failed with signal $sig (local problem) -- giving back\n"); + } else { + $self->log("sbuild of $todo->{'pv'} failed with unknown reason (local problem) -- giving back\n"); + } + + if ($giveback) { + $db->run_query('--give-back', '--dist=' . $dist_config->get('DIST_NAME'), $todo->{'pv'}); + $self->add_given_back($todo->{'pv'}); + $self->write_stats("give-back", 1); + } + + # Check if we encountered some local error to stop further building + if ($giveback) { + if (!defined $main::sbuild_fails) { + $main::sbuild_fails = 0; + } + + $main::sbuild_fails++; + + if ($main::sbuild_fails > $self->get_conf('MAX_SBUILD_FAILS')) { + $self->log("sbuild now failed $main::sbuild_fails times in ". + "a row; going to sleep\n"); + send_mail( $self->get_conf('ADMIN_MAIL'), + "Repeated mess with sbuild", + <<EOF ); +The execution of sbuild now failed for $main::sbuild_fails times. +These are the first $sbuild_output_line_count lines of the last failed sbuild call: +@sbuild_output_buffer + +The daemon is going to sleep for 1 hour, or can be restarted with SIGUSR2. +EOF + my $oldsig; + eval <<'EOF'; +$oldsig = $SIG{'USR2'}; +$SIG{'USR2'} = sub ($) { die "signal\n" }; +my $idle_start_time = time; +sleep( 60*60 ); +my $idle_end_time = time; +$SIG{'USR2'} = $oldsig; +$self->write_stats("idle-time", $idle_end_time - $idle_start_time); +EOF + $main::sbuild_fails = 0; + } + } + else { + # Either a build success or an attempted build will cause the + # counter to reset. + $main::sbuild_fails = 0; + } + $self->log("Build finished.\n"); +} + +sub move_to_upload { + my $self = shift; + my $dist_config = shift; + my $pv = shift; + my $binNMUver = shift; + + my $arch = $dist_config->get('BUILT_ARCHITECTURE'); + my $upload_dir = $dist_config->get('DUPLOAD_LOCAL_QUEUE_DIR'); + my $file_suffix = $self->get_conf('DPKG_FILE_SUFFIX'); + + if ($binNMUver) { + $pv .= '+b' . $binNMUver; + } + + my $pkg_noepoch = $pv; + $pkg_noepoch =~ s/_\d*:/_/; + + my $changes_name = $pkg_noepoch . '_' . $arch . $file_suffix . '.changes'; + my $upload_path = $self->get_conf('HOME') . '/' . $dist_config->get('DUPLOAD_LOCAL_QUEUE_DIR') . '/' . $pkg_noepoch . '_' . $arch . '.upload'; + + $self->log("$pv is autosigned, moving to '$upload_dir'\n"); + if ( -f $upload_path ) { + unlink( $upload_path ); + $self->log("'$upload_path' removed.\n"); + } + system(qw(dcmd mv --), + sprintf('%s/build/%s', $self->get_conf('HOME'), $changes_name), + sprintf('%s/%s/', $self->get_conf('HOME'), $dist_config->get('DUPLOAD_LOCAL_QUEUE_DIR')) + ); + $self->log("$pv moved to '$upload_dir'\n"); +} + +sub handle_prevfailed { + my $self = shift; + my $dist_config = shift; + my $pkgv = shift; + + my $dist_name = $dist_config->get('DIST_NAME'); + my( $pkg, $fail_msg, $changelog); + + $self->log("$pkgv previously failed -- asking admin first\n"); + ($pkg = $pkgv) =~ s/_.*$//; + + my $db = $self->get_db_handle($dist_config); + my $pipe = $db->pipe_query( + '--info', + $pkg); + if (!$pipe) { + $self->log("Can't run wanna-build: $!\n"); + return; + } + + $fail_msg = ""; + while (<$pipe>) { + $fail_msg .= $_; + } + + close($pipe); + if ($?) { + $self->log("wanna-build exited with error $?\n"); + return; + } + + send_mail( $self->get_conf('ADMIN_MAIL'), + "Should I build $pkgv (dist=${dist_name})?", + "The package $pkg failed to build in a previous version. ". + "The fail\n". + "messages are:\n\n$fail_msg\n". + "Should buildd try to build the new version, or should it ". + "fail with the\n". + "same messages again.? Please answer with 'build' (or 'ok'), ". + "or 'fail'.\n" ); +} + +sub get_changelog { + # This method is currently broken. It makes some assumptions about source + # layout that are no longer true. Furthermore it tries fetching through + # the host instead of creating a session (which is necessary for snapshot- + # based chroots) and work in the chroot. + + my $self = shift; + my $dist_config = shift; + my $pkg = shift; + + my $dist_name = $dist_config->get('DIST_NAME'); + my $changelog = ""; + my $analyze = ""; + my $chroot_apt_options; + my $file; + my $retried = 0; + + $pkg =~ /^([\w\d.+-]+)_([\w\d:.~+-]+)/; + my ($n, $v) = ($1, $2); + (my $v_ne = $v) =~ s/^\d+://; + my $pkg_ne = "${n}_${v_ne}"; + +retry: + my @schroot = ($self->get_conf('SCHROOT'), '-c', + $dist_name . '-' . $self->get_conf('ARCH') . '-sbuild', '--'); + my @schroot_root = ($self->get_conf('SCHROOT'), '-c', + $dist_name . '-' . $self->get_conf('ARCH') . '-sbuild', + '-u', 'root', '--'); + my $apt_get = $self->get_conf('APT_GET'); + + my $pipe = $self->get('Host')->pipe_command( + { COMMAND => [@schroot, + "$apt_get", '-q', '-d', + '--diff-only', 'source', "$n=$v"], + USER => $self->get_conf('USERNAME'), + PRIORITY => 0, + }); + if (!$pipe) { + $self->log("Can't run schroot: $!\n"); + return; + } + + my $msg = ""; + while (<$pipe>) { + $msg .= $_; + } + + close($pipe); + + if ($? == 0 && $msg !~ /get 0B/) { + $analyze = "diff"; + $file = "${n}_${v_ne}.diff.gz"; + } + + if (!$analyze) { + my $pipe2 = $self->get('Host')->pipe_command( + { COMMAND => [@schroot, + "$apt_get", '-q', '-d', + '--tar-only', 'source', "$n=$v"], + USER => $self->get_conf('USERNAME'), + PRIORITY => 0, + }); + if (!$pipe2) { + $self->log("Can't run schroot: $!\n"); + return; + } + + my $msg = <$pipe2>; + + close($pipe2); + + if ($? == 0 && $msg !~ /get 0B/) { + $analyze = "tar"; + $file = "${n}_${v_ne}.tar.gz"; + } + } + + if (!$analyze && !$retried) { + $self->get('Host')->run_command( + { COMMAND => [@schroot_root, + $apt_get, '-qq', + 'update'], + USER => $self->get_conf('USERNAME'), + PRIORITY => 0, + STREAMOUT => $devnull + }); + + $retried = 1; + goto retry; + } + + return "ERROR: cannot find any source" if !$analyze; + + if ($analyze eq "diff") { + if (!open( F, "gzip -dc '$file' 2>/dev/null |" )) { + return "ERROR: Cannot spawn gzip to zcat $file: $!"; + } + while( <F> ) { + # look for header line of a file */debian/changelog + last if m,^\+\+\+\s+[^/]+/debian/changelog(\s+|$),; + } + while( <F> ) { + last if /^---/; # end of control changelog patch + next if /^\@\@/; + $changelog .= "$1\n" if /^\+(.*)$/; + last if /^\+\s+--\s+/; + } + while( <F> ) { } # read to end of file to avoid broken pipe + close( F ); + if ($?) { + return "ERROR: error status ".exitstatus($?)." from gzip on $file"; + } + unlink( $file ); + } + elsif ($analyze eq "tar") { + if (!open( F, "tar -xzOf '$file' '*/debian/changelog' ". + "2>/dev/null |" )) { + return "ERROR: Cannot spawn tar for $file: $!"; + } + while( <F> ) { + $changelog .= $_; + last if /^\s+--\s+/; + } + while( <F> ) { } # read to end of file to avoid broken pipe + close( F ); + if ($?) { + return "ERROR: error status ".exitstatus($?)." from tar on $file"; + } + unlink( $file ); + } + + return $changelog; +} + +sub check_restart { + my $self = shift; + my @stats = stat( $self->get('MY_BINARY') ); + + if (@stats && $self->get('MY_BINARY_TIME') != $stats[ST_MTIME]) { + $self->log("My binary has been updated -- restarting myself (pid=$$)\n"); + unlink( $self->get_conf('PIDFILE') ); + kill ( 15, $main::ssh_pid ) if $main::ssh_pid; + exec $self->get('MY_BINARY'); + } + + if ( -f $self->get_conf('HOME') . "/EXIT-DAEMON-PLEASE" ) { + unlink($self->get_conf('HOME') . "/EXIT-DAEMON-PLEASE"); + $self->shutdown("NONE (flag file exit)"); + } +} + +sub block_signals { + my $self = shift; + + POSIX::sigprocmask( SIG_BLOCK, $main::block_sigset ); +} + +sub unblock_signals { + my $self = shift; + + POSIX::sigprocmask( SIG_UNBLOCK, $main::block_sigset ); +} + +sub check_ssh_master { + my $self = shift; + my $dist_config = shift; + + my $ssh_socket = $dist_config->get('WANNA_BUILD_SSH_SOCKET'); + + return 1 if (!$ssh_socket); + return 1 if ( -S $ssh_socket ); + + my $ssh_master_pids = {}; + if ($self->get('SSH_MASTER_PIDS')) { + $ssh_master_pids = $self->get('SSH_MASTER_PIDS'); + } else { + $self->set('SSH_MASTER_PIDS', $ssh_master_pids); + } + + if ($ssh_master_pids->{$ssh_socket}) + { + my $wpid = waitpid ( $ssh_master_pids->{$ssh_socket}, WNOHANG ); + return 1 if ($wpid != -1 and $wpid != $ssh_master_pids->{$ssh_socket}); + } + + my $new_master_pid = fork; + + #We are in the newly forked child: + if (defined($new_master_pid) && $new_master_pid == 0) { + exec (@{$dist_config->get('WANNA_BUILD_SSH_CMD')}, "-MN"); + } + + #We are the parent: + if (!defined $new_master_pid) { + $self->log("Cannot fork for ssh master: $!\n"); + return 0; + } + + $ssh_master_pids->{$ssh_socket} = $new_master_pid; + + while ( ! -S $ssh_socket ) + { + sleep 1; + my $wpid = waitpid ( $new_master_pid, WNOHANG ); + return 0 if ($wpid == -1 or $wpid == $new_master_pid); + } + return 1; +} + +sub shutdown { + my $self = shift; + my $signame = shift; + + $self->log("buildd ($$) received SIG$signame -- shutting down\n"); + + if ($self->get('SSH_MASTER_PIDS')) { + my $ssh_master_pids = $self->get('SSH_MASTER_PIDS'); + for my $ssh_socket (keys %{$ssh_master_pids}) { + my $master_pid = $ssh_master_pids->{$ssh_socket}; + kill ( 15, $master_pid ); + delete ( $ssh_master_pids->{$ssh_socket} ); + } + } + + if (defined $main::sbuild_pid) { + $self->log("Killing sbuild (pid=$main::sbuild_pid)\n"); + kill( 15, $main::sbuild_pid ); + $self->log("Waiting max. 2 minutes for sbuild to finish\n"); + $SIG{'ALRM'} = sub ($) { die "timeout\n"; }; + alarm( 120 ); + eval "waitpid( $main::sbuild_pid, 0 )"; + alarm( 0 ); + if ($@) { + $self->log("sbuild did not die!"); + } + else { + $self->log("sbuild died normally"); + } + unlink( "SBUILD-REDO-DUMPED" ); + } + unlink( $self->get('Config')->get('PIDFILE') ); + $self->log("exiting now\n"); + $self->close_log(); + exit 1; +} + +1; diff --git a/lib/Buildd/DistConf.pm b/lib/Buildd/DistConf.pm new file mode 100644 index 0000000..6edffba --- /dev/null +++ b/lib/Buildd/DistConf.pm @@ -0,0 +1,159 @@ +# +# Conf.pm: configuration library for buildd +# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de> +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2006-2009 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Buildd::DistConf; + +use strict; +use warnings; + +use Sbuild::ConfBase; +use Sbuild::Sysconfig; +use Buildd::ClientConf qw(); + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter); + + @EXPORT = qw(new_hash setup read_hash); +} + +sub new_hash (@); +sub setup ($); +sub read_hash ($$); + +sub new_hash (@) { + my %opts = @_; + + my $queue_config = Sbuild::ConfBase->new(%opts); + + Buildd::DistConf::setup($queue_config); + Buildd::DistConf::read_hash($queue_config, $opts{'HASH'}); + + return $queue_config; +} + +sub setup ($) { + my $conf = shift; + + my $validate_directory_in_home = sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + my $directory = $conf->get($key); + my $home_directory = $conf->get('HOME'); + + die "$key directory is not defined" + if !defined($directory) || !$directory; + + die "$key directory '$home_directory/$directory' does not exist" + if !-d $home_directory . "/" . $directory; + }; + + my $arch = $conf->get('ARCH'); + + my %buildd_dist_keys = ( + 'DIST_NAME' => { + DEFAULT => 'unstable' + }, + 'BUILT_ARCHITECTURE' => { + DEFAULT => undef, + }, + 'SBUILD_CHROOT' => { + DEFAULT => undef, + }, + 'WANNA_BUILD_SSH_HOST' => { + DEFAULT => 'buildd.debian.org' + }, + 'WANNA_BUILD_SSH_USER' => { + DEFAULT => 'buildd_' . $arch + }, + 'WANNA_BUILD_SSH_SOCKET' => { + DEFAULT => undef + }, + 'WANNA_BUILD_SSH_OPTIONS' => { + DEFAULT => [] + }, + 'WANNA_BUILD_DB_NAME' => { + DEFAULT => undef, + }, + 'WANNA_BUILD_DB_USER' => { + DEFAULT => $Buildd::username + }, + 'WANNA_BUILD_API' => { + DEFAULT => undef, + }, + 'WANNA_BUILD_MIN_AGE' => { + DEFAULT => undef, + }, + 'DUPLOAD_LOCAL_QUEUE_DIR' => { + CHECK => $validate_directory_in_home, + DEFAULT => 'upload' + }, + 'NO_AUTO_BUILD' => { + DEFAULT => [] + }, + 'WEAK_NO_AUTO_BUILD' => { + DEFAULT => [] + }, + 'NO_BUILD_REGEX' => { + DEFAULT => undef + }, + 'BUILD_REGEX' => { + DEFAULT => undef + }, + 'LOGS_MAILED_TO' => { + DEFAULT => undef + }, + 'LOGS_MAIL_ALSO' => { + DEFAULT => undef + }, + 'BUILD_DEP_RESOLVER' => { + DEFAULT => undef + }, + 'SIGN_WITH' => { + DEFAULT => undef + }, + 'MAINTAINER_NAME' => { + DEFAULT => undef + }, + 'MAILFROM' => { + DEFAULT => undef + }, + ); + + $conf->set_allowed_keys(\%buildd_dist_keys); + + Buildd::ClientConf::setup($conf); +} + +sub read_hash($$) { + my $conf = shift; + my $data = shift; + + for my $key (keys %$data) { + $conf->set($key, $data->{$key}); + } +} + +1; diff --git a/lib/Buildd/Mail.pm b/lib/Buildd/Mail.pm new file mode 100644 index 0000000..09f43ec --- /dev/null +++ b/lib/Buildd/Mail.pm @@ -0,0 +1,1354 @@ +# buildd-mail: mail answer processor for buildd +# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de> +# Copyright © 2009 Roger Leigh <rleigh@debian.org> +# Copyright © 2005 Ryan Murray <rmurray@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Buildd::Mail; + +use strict; +use warnings; + +use Buildd qw(ll_send_mail lock_file unlock_file send_mail exitstatus); +use Buildd::Conf qw(); +use Buildd::Base; +use Sbuild qw(binNMU_version $devnull); +use Sbuild::ChrootRoot; +use Buildd::Client; +use POSIX; +use File::Basename; +use MIME::QuotedPrint; +use MIME::Base64; +use Encode; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Buildd::Base); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + + my $self = $class->SUPER::new($conf); + bless($self, $class); + + $self->set('Mail Error', undef); + $self->set('Mail Short Error', undef); + $self->set('Mail Header', {}); + $self->set('Mail Body Text', ''); + + $self->open_log(); + + return $self; +} + +sub run { + my $self = shift; + + chdir($self->get_conf('HOME')); + + $self->set('Mail Error', undef); + $self->set('Mail Short Error', undef); + $self->set('Mail Header', {}); + $self->set('Mail Body Text', ''); + + $self->process_mail(); + + return 0; +} + + +sub process_mail () { + my $self = shift; + +# Note: Mail Header (to|from|subject|message-id|date) are mandatory. +# Check for these and bail out if not present. + my $header_text = ""; + my $lastheader = ""; + + $self->set('Mail Header', {}); + + $self->set('Mail Error', ''); + $self->set('Mail Short Error', ''); + $self->set('Mail Header', {}); + $self->set('Mail Body Text', ''); + + while( <STDIN> ) { + $header_text .= $_; + last if /^$/; + + if (/^\s/ && $lastheader) { + $_ =~ s/^\s+//; + $_ = "$lastheader $_"; + } + + if (/^From (\S+)/) { + ; + } + if (/^([\w\d-]+):\s*(.*)\s*$/) { + my $hname; + ($hname = $1) =~ y/A-Z/a-z/; + $self->get('Mail Header')->{$hname} = $2; + $lastheader = $_; + chomp( $lastheader ); + } + else { + $lastheader = ""; + } + } + while( <STDIN> ) { + last if !/^\s*$/; + } + + $self->set('Mail Body Text', + $self->get('Mail Body Text') . $_) + if defined($_); + + if (!eof) + { + local($/); + undef $/; + $self->set('Mail Body Text', + $self->get('Mail Body Text') . <STDIN>); + } + + if ($self->get('Mail Header')->{'from'} =~ /mail\s+delivery\s+(sub)?system|mailer.\s*daemon/i) { + # is an error mail from a mailer daemon + # To avoid mail loops if this error resulted from a mail we sent + # outselves, we break the loop by not forwarding this mail after the 5th + # error mail within 8 hours or so. + my $n = $self->add_error_mail(); + if ($n > 5) { + $self->log("Too much error mails ($n) within ", + int($self->get_conf('ERROR_MAIL_WINDOW')/(60*60)), " hours\n", + "Not forwarding mail from ".$self->get('Mail Header')->{'from'}."\n", + "Subject: " . $self->get('Mail Header')->{'subject'} . "\n"); + return; + } + } + + goto forward_mail if !$self->get('Mail Header')->{'subject'}; + my $subject = $self->get('Mail Header')->{'subject'}; + Encode::from_to($subject, "MIME-Header", "utf-8"); + + if ($subject =~ /^Re: Log for \S+ build of (\S+)(?: on [\w-]+)? \(dist=(\S+)\)/i) { + # reply to a build log + my( $package, $dist_name ) = ( $1, $2 ); + + my $dist_config = $self->get_dist_config_by_name($dist_name); + return if (!$dist_config); #get_dist_config sets the error mail + + my $text = $self->get('Mail Body Text'); + $text =~ /^(\S+)/; + $self->set('Mail Body Text', $text); + if (defined($self->get('Mail Header')->{'content-transfer-encoding'})) { + # Decode the mail if necessary. + if ($self->get('Mail Header')->{'content-transfer-encoding'} =~ /quoted-printable/) { + $self->set('Mail Body Text', + decode_qp($self->get('Mail Body Text'))); + } elsif ($self->get('Mail Header')->{'content-transfer-encoding'} =~ /base64/) { + $self->set('Mail Body Text', + decode_base64($self->get('Mail Body Text'))); + } + } + my $keyword = $1; + my $from = $self->get('Mail Header')->{'from'}; + $from = $1 if $from =~ /<(.+)>/; + $self->log("Log reply from $from\n"); + my %newv; + + if ($keyword =~ /^not-for-us/) { + $self->no_build( $package, $dist_config ); + $self->purge_pkg( $package, $dist_config ); + } + elsif ($keyword =~ /^up(l(oad)?)?-rem/) { + $self->remove_from_upload( $package, $dist_config ); + } + elsif ($self->check_is_outdated( $dist_config, $package )) { + # Error has been set already -> no action here + } + elsif ($keyword =~ /^fail/) { + my $text = $self->get('Mail Body Text'); + $text =~ s/^fail.*\n(\s*\n)*//; + $text =~ s/\n+$/\n/; + $self->set_to_failed( $package, $dist_config, $text ); + $self->purge_pkg( $package, $dist_config ); + } + elsif ($keyword =~ /^ret/) { + if (!$self->check_state( $package, $dist_config, qw(Built Building Build-Attempted) )) { + # Error already set + } + else { + $self->append_to_REDO( $package, $dist_config ); + } + } + elsif ($keyword =~ /^d(ep(endency)?)?-(ret|w)/) { + if (!$self->check_state( $package, $dist_config, qw(Built Building Build-Attempted) )) { + # Error already set + } + else { + $self->get('Mail Body Text') =~ /^\S+\s+(.*)$/m; + my $deps = $1; + $self->set_to_depwait( $package, $dist_config, $deps ); + $self->purge_pkg( $package, $dist_config ); + } + } + elsif ($keyword =~ /^man/) { + if (!$self->check_state( $package, $dist_config, qw(Built Building Build-Attempted) )) { + # Error already set + } + else { + # no action + $self->log("$package($dist_name) will be finished manually\n"); + } + } + elsif ($keyword =~ /^newv/) { + # build a newer version instead + $self->get('Mail Body Text') =~ /^newv\S*\s+(\S+)/; + my $newv = $1; + if ($newv =~ /_/) { + $self->log("Removing unneeded package name from $newv\n"); + $newv =~ s/^.*_//; + $self->log("Result: $newv\n"); + } + my $pkgname; + ($pkgname = $package) =~ s/_.*$//; + $self->redo_new_version( $dist_config, $package, "${pkgname}_${newv}" ); + $self->purge_pkg( $package, $dist_config ); + } + elsif ($keyword =~ /^(give|back)/) { + $self->get('Mail Body Text') =~ /^(give|back) ([-0-9]+)/; + my $pri = $1; + if (!$self->check_state( $package, $dist_config, qw(Built Building Build-Attempted) )) { + # Error already set + } + else { + $self->give_back( $package, $dist_config ); + $self->purge_pkg( $package, $dist_config ); + } + } + elsif ($keyword =~ /^purge/) { + $self->purge_pkg( $package, $dist_config ); + } + elsif ($self->get('Mail Body Text') =~ /^---+\s*BEGIN PGP SIGNED MESSAGE/) { + if ($self->prepare_for_upload( $package, + $self->get('Mail Body Text') )) { + $self->purge_pkg( $package, $dist_config ); + } + } + elsif ($self->get('Mail Body Text') =~ /^--/ && + $self->get('Mail Header')->{'content-type'} =~ m,multipart/signed,) { + my ($prot) = ($self->get('Mail Header')->{'content-type'} =~ m,protocol="([^"]*)",); + my ($bound) = ($self->get('Mail Header')->{'content-type'} =~ m,boundary="([^"]*)",); + my $text = $self->get('Mail Body Text'); + $text =~ s,^--\Q$bound\E\nContent-Type: text/plain; charset=us-ascii\n\n,-----BEGIN PGP SIGNED MESSAGE-----\n\n,; + $text =~ s,--\Q$bound\E\nContent-Type: application/pgp-signature\n\n,,; + $text =~ s,\n\n--\Q$bound\E--\n,,; + $self->set('Mail Body Text', $text); + if ($self->prepare_for_upload($package, + $self->get('Mail Body Text'))) { + $self->purge_pkg( $package, $dist_config ); + } + } + else { + $self->set('Mail Short Error', + $self->get('Mail Short Error') . + "Bad keyword in answer $keyword\n"); + $self->set('Mail Error', + $self->get('Mail Error') . + "Answer not understood (expected retry, failed, manual,\n". + "dep-wait, giveback, not-for-us, purge, upload-rem,\n". + "newvers, or a signed changes file)\n"); + } + } + elsif ($subject =~ /^Re: Should I build (\S+) \(dist=(\S+)\)/i) { + # reply whether a prev-failed package should be built + my( $package, $dist_name ) = ( $1, $2 ); + + my $dist_config = $self->get_dist_config_by_name($dist_name); + return if (!$dist_config); #get_dist_config sets the error mail + + $self->get('Mail Body Text') =~ /^(\S+)/; + my $keyword = $1; + $self->log("Should-build reply for $package($dist_name)\n"); + if ($self->check_is_outdated( $dist_config, $package )) { + # Error has been set already -> no action here + } + elsif (!$self->check_state( $package, $dist_config, qw(Built Building Build-Attempted) )) { + # Error already set + } + elsif ($keyword =~ /^(build|ok)/) { + $self->append_to_REDO( $package, $dist_config ); + } + elsif ($keyword =~ /^fail/) { + my $text = $self->get_fail_msg( $package, $dist_config ); + $self->set_to_failed( $package, $dist_config, $text ); + } + elsif ($keyword =~ /^(not|no-b)/) { + $self->no_build( $package, $dist_config ); + } + elsif ($keyword =~ /^(give|back)/) { + $self->give_back( $package, $dist_config ); + } + else { + $self->set('Mail Short Error', + $self->get('Mail Short Error') . + "Bad keyword in answer $keyword\n"); + $self->set('Mail Error', + $self->get('Mail Error') . + "Answer not understood (expected build, ok, fail, ". + "give-back, or no-build)\n"); + } + } + elsif ($subject =~ /^Processing of (\S+)/) { + my $job = $1; + # mail from Erlangen queue daemon: forward all non-success messages + my $text = $self->get('Mail Body Text'); + goto forward_mail if $text !~ /uploaded successfully/mi; + $self->log("$job processed by upload queue\n") + if $self->get_conf('LOG_QUEUED_MESSAGES'); + } + elsif ($subject =~ /^([-+~\.\w]+\.changes) (INSTALL|ACCEPT)ED/) { + # success mail from dinstall + my $changes_f = $1; + my( @to_remove, $upload_f, $pkgv ); + my @upload_dirs = $self->find_upload_dirs_for_changes_file($changes_f); + + if ((scalar @upload_dirs) < 1) { + $self->log("Can't identify upload directory for $changes_f!\n"); + return 0; + } elsif ((scalar @upload_dirs) > 1) { + $self->log("Found more than one upload directory for $changes_f - not deleting binaries!\n"); + return 0; + } + my $upload_dir = $upload_dirs[0]; + + if (-f "$upload_dir/$changes_f" && open( F, "<$upload_dir/$changes_f" )) { + local($/); undef $/; + my $changetext = <F>; + close( F ); + push( @to_remove, $self->get_files_from_changes( $changetext ) ); + } else { + foreach (split( "\n", $self->get('Mail Body Text'))) { + if (/^(\[-+~\.\w]+\.(u?deb))$/) { + my $f = $1; + push( @to_remove, $f ) if !grep { $_ eq $f } @to_remove; + } + } + } + ($upload_f = $changes_f) =~ s/\.changes$/\.upload/; + push( @to_remove, $changes_f, $upload_f ); + ($pkgv = $changes_f) =~ s/_(\S+)\.changes//; + $self->log("$pkgv has been installed; removing from upload dir:\n", + "@to_remove\n"); + + my @dists; + if (open( F, "<$upload_dir/$changes_f" )) { + my $changes_text; + { local($/); undef $/; $changes_text = <F>; } + close( F ); + @dists = $self->get_dists_from_changes( $changes_text ); + } else { + $self->log("Cannot get dists from $upload_dir/$changes_f: $! (assuming unstable)\n"); + @dists = ( "unstable" ); + } + +FILE: foreach (@to_remove) { + if (/\.deb$/) { + # first listed wins + foreach my $dist (@dists) { + if ( -d $self->get_conf('HOME') . "/build/chroot-$dist" && + -w $self->get_conf('HOME') . "/build/chroot-$dist/var/cache/apt/archives/") { + # TODO: send all of to_remove to perl-apt if it's available, setting a try_mv list + # that only has build-depends in it. + # if that's too much cpu, have buildd use perl-apt if avail to export the + # build-depends list, which could then be read in at this point + if (system (qw(mv --), "$upload_dir/$_", + $self->get_conf('HOME') . + "/build/chroot-$dist/var/cache/apt/archives/")) { + $self->log("Cannot move $upload_dir/$_ to cache dir\n"); + } else { + next FILE; + } + } + } + } + unlink "$upload_dir/$_" + or $self->log("Can't remove $upload_dir/$_: $!\n"); +} + } + elsif ($subject =~ /^(\S+\.changes) is NEW$/) { + # "is new" mail from dinstall + my $changes_f = $1; + my $pkgv; + ($pkgv = $changes_f) =~ s/_(\S+)\.changes//; + $self->log("$pkgv must be manually dinstall-ed -- delayed\n"); + } + elsif ($subject =~ /^new version of (\S+) \(dist=(\S+)\)$/) { + # notice from wanna-build + my ($pkg, $dist_name) = ($1, $2); + my $dist_config = $self->get_dist_config_by_name($dist_name); + goto forward if $self->get('Mail Body Text') !~ /^in version (\S+)\.$/m; + my $pkgv = $pkg."_".$1; + $self->get('Mail Body Text') =~ /new source version (\S+)\./m; + my $newv = $1; + $self->log("Build of $pkgv ($dist_name) obsolete -- new version $newv\n"); + $self->register_outdated( $dist_name, $pkgv, $pkg."_".$newv ); + + my @ds; + if (!(@ds = $self->check_building_any_dist( $pkgv ))) { + if (!$self->remove_from_REDO( $pkgv )) { + $self->append_to_SKIP( $pkgv ); + } + $self->purge_pkg( $pkgv, $dist_config ); + } + else { + $self->log("Not deleting, still building for @ds\n"); + } + } + elsif ($self->get('Mail Body Text') =~ /^blacklist (\S+)\n$/) { + my $pattern = "\Q$1\E"; + if (open( F, ">>mail-blacklist" )) { + print F "$pattern\n"; + close( F ); + $self->log("Added $pattern to blacklist.\n"); + } + else { + $self->log("Can't open mail-blacklist for appending: $!\n"); + } + } + else { + goto forward_mail; + } + + + if ($self->get('Mail Error')) { + $self->log("Error: ", + $self->get('Mail Short Error') || $self->get('Mail Error')); + $self->reply("Your mail could not be processed:\n" . + $self->get('Mail Error')); + } + return; + +forward_mail: + my $header = $self->get('Mail Header'); + $self->log("Mail from $header->{'from'}\nSubject: $subject\n"); + if ($self->is_blacklisted( $self->get('Mail Header')->{'from'} )) { + $self->log("Address is blacklisted, deleting mail.\n"); + } + else { + $self->log("Not for me, forwarding to admin\n"); + ll_send_mail( $self->get_conf('ADMIN_MAIL'), + "To: $header->{'to'}\n". + ($header->{'cc'} ? "Cc: $header->{'cc'}\n" : ""). + "From: $header->{'from'}\n". + "Subject: $header->{'subject'}\n". + "Date: $header->{'date'}\n". + "Message-Id: $header->{'message-id'}\n". + ($header->{'reply-to'} ? "Reply-To: $header->{'reply-to'}\n" : ""). + ($header->{'in-reply-to'} ? "In-Reply-To: $header->{'in-reply-to'}\n" : ""). + ($header->{'references'} ? "References: $header->{'references'}\n" : ""). + ($header->{'content-type'} ? "Content-Type: $header->{'content-type'}\n": ""). + "Resent-From: $Buildd::gecos <$Buildd::username\@$Buildd::hostname>\n". + "Resent-To: " . $self->get_conf('ADMIN_MAIL') . "\n\n". + $self->get('Mail Body Text') ); + } +} + + +sub prepare_for_upload ($$) { + my $self = shift; + my $pkg = shift; + my $changes = shift; + + $changes =~ s/\n+$/\n/; + + my( @files, @md5, @missing, @md5fail, $i ); + + my @to_dists = $self->get_dists_from_changes( $changes ); + if (!@to_dists) { # probably not a valid changes + + $self->set('Mail Short Error', + $self->get('Mail Error')); + $self->set('Mail Error', + $self->get('Mail Error') . + "Couldn't find a valid Distribution: line.\n"); + return 0; + } + + my $changes_filename_arch = $self->get_conf('ARCH'); + #Try to extract the arch from the actual changes file (see #566398) + if ($changes =~ /^Architecture:\s*(.+)/m) { + my @arches = grep { $_ ne "all" } split /\s+/, $1; + if (@arches > 1) { + $changes_filename_arch = "multi"; + } else { + $changes_filename_arch = $arches[0]; + } + } + + $changes =~ /^Files:\s*\n((^[ ]+.*\n)*)/m; + foreach (split( "\n", $1 )) { + push( @md5, (split( /\s+/, $_ ))[1] ); + push( @files, (split( /\s+/, $_ ))[5] ); + } + if (!@files) { # probably not a valid changes + $self->set('Mail Short Error', + $self->get('Mail Error')); + $self->set('Mail Error', + $self->get('Mail Error') . + "No files listed in changes.\n"); + return 0; + } + my @wrong_dists = (); + foreach my $d (@to_dists) { + push( @wrong_dists, $d ) + if !$self->check_state( + $pkg, + $self->get_dist_config_by_name($d), + qw(Building Built Install-Wait Reupload-Wait Build-Attempted)); + } + if (@wrong_dists) { + $self->set('Mail Short Error', + $self->get('Mail Error')); + $self->set('Mail Error', + $self->get('Mail Error') . + "Package $pkg has target distributions @wrong_dists\n". + "for which it isn't registered as Building.\n". + "Please fix this by either modifying the Distribution: ". + "header or\n". + "taking the package in those distributions, too.\n"); + return 0; + } + + for( $i = 0; $i < @files; ++$i ) { + if (! -f $self->get_conf('HOME') . "/build/$files[$i]") { + push( @missing, $files[$i] ) ; + } + else { + my $home = $self->get_conf('HOME'); + chomp( my $sum = `md5sum $home/build/$files[$i]` ); + push( @md5fail, $files[$i] ) if (split(/\s+/,$sum))[0] ne $md5[$i]; + } + } + if (@missing) { + $self->set('Mail Short Error', + $self->get('Mail Short Error') . + "Missing files for move: @missing\n"); + $self->set('Mail Error', + $self->get('Mail Error') . + "While trying to move the built package $pkg to upload,\n". + "the following files mentioned in the .changes were not found:\n". + "@missing\n"); + return 0; + } + if (@md5fail) { + $self->set('Mail Short Error', + $self->get('Mail Short Error') . + "md5 failure during move: @md5fail\n"); + $self->set('Mail Error', + $self->get('Mail Error') . + "While trying to move the built package $pkg to upload,\n". + "the following files had bad md5 checksums:\n". + "@md5fail\n"); + return 0; + } + + my @upload_dirs = $self->get_upload_queue_dirs ( $changes ); + + my $pkg_noep = $pkg; + $pkg_noep =~ s/_\d*:/_/; + my $changes_name = $pkg_noep . "_" . $changes_filename_arch . ".changes"; + + for my $upload_dir (@upload_dirs) { + if (! -d $upload_dir &&!mkdir( $upload_dir, 0750 )) { + $self->set('Mail Error', + $self->get('Mail Error') . + "Cannot create directory $upload_dir"); + $self->log("Cannot create dir $upload_dir\n"); + return 0; + } + } + + my $errs = 0; + for my $upload_dir (@upload_dirs) { + lock_file( $upload_dir ); + foreach (@files) { + if (system('cp', '--', $self->get_conf('HOME')."/build/$_", "$upload_dir/$_")) { + $self->log("Cannot copy $_ to $upload_dir/\n"); + ++$errs; + } + } + + open( F, ">$upload_dir/$changes_name" ); + print F $changes; + close( F ); + unlock_file( $upload_dir ); + $self->log("Moved $pkg to ", basename($upload_dir), "\n"); + } + + foreach (@files) { + if (!unlink($self->get_conf('HOME') . "/build/$_")) { + $self->log("Cannot remove build/$_\n"); + ++$errs; + } + } + + if ($errs) { + $self->set('Mail Error', + $self->get('Mail Error') . + "Could not move all files to upload dir."); + return 0; + } + + unlink( $self->get_conf('HOME') . "/build/$changes_name" ) + or $self->log("Cannot remove " . $self->get_conf('HOME') . "/$changes_name: $!\n"); +} + +sub redo_new_version ($$$) { + my $self = shift; + my $dist_config = shift; + my $oldv = shift; + my $newv = shift; + + my $err = 0; + + my $db = $self->get_db_handle($dist_config); + my $pipe = $db->pipe_query('-v', $newv); + if ($pipe) { + while(<$pipe>) { + next if /^wanna-build Revision/ || + /^\S+: Warning: Older version / || + /^\S+: ok$/; + $self->set('Mail Error', + $self->get('Mail Error') . $_); + $err = 1; + } + close($pipe); + } else { + $self->log("Can't spawn wanna-build: $!\n"); + $self->set('Mail Error', + $self->get('Mail Error') . + "Can't spawn wanna-build: $!\n"); + return; + } + if ($err) { + $self->log("Can't take newer version $newv due to wanna-build errors\n"); + return; + } + $self->log("Going to build $newv instead of $oldv\n"); + + $self->append_to_REDO( $newv, $dist_config ); +} + +sub purge_pkg ($$) { + my $self = shift; + my $pkg = shift; + my $dist_config = shift; + my $dist_name = $dist_config->get('DIST_NAME'); + + my $dir; + local( *F ); + + $self->remove_from_REDO( $pkg ); + + # remove .changes and .deb in build dir (if existing) + my $pkg_noep = $pkg; + $pkg_noep =~ s/_\d*:/_/; + my $changes = "${pkg_noep}_" . $self->get_conf('ARCH') . ".changes"; + if (-f "build/$changes" && open( F, "<build/$changes" )) { + local($/); undef $/; + my $changetext = <F>; + close( F ); + my @files = $self->get_files_from_changes( $changetext ); + push( @files, $changes ); + $self->log("Purging files: $changes\n"); + unlink( map { "build/$_" } @files ); + } + + # schedule dir for purging + ($dir = $pkg_noep) =~ s/-[^-]*$//; # remove Debian revision + $dir =~ s/_/-/; # change _ to - + if (-d "build/chroot-$dist_name/build/$Buildd::username/$dir") { + $dir = "build/chroot-$dist_name/build/$Buildd::username/$dir"; + } + else { + $dir = "build/$dir"; + } + return if ! -d $dir; + + lock_file( "build/PURGE" ); + if (open( F, ">>build/PURGE" )) { + print F "$dir\n"; + close( F ); + $self->log("Scheduled $dir for purging\n"); + } + else { + $self->set('Mail Error', + $self->get('Mail Error') . + "Can't open build/PURGE: $!\n"); + $self->log("Can't open build/PURGE: $!\n"); + } + unlock_file( "build/PURGE" ); +} + +sub remove_from_upload ($) { + my $self = shift; + my $pkg = shift; + my $dist_config = shift; + + my($changes_f, $upload_f, $changes_text, @to_remove); + local( *F ); + + $self->log("Remove $pkg from upload dir\n"); + my $pkg_noep = $pkg; + $pkg_noep =~ s/_\d*:/_/; + $changes_f = "${pkg_noep}_" . $self->get_conf('ARCH') . ".changes"; + + my $upload_dir = $self->get_conf('HOME') . '/' . $dist_config->get('DUPLOAD_LOCAL_QUEUE_DIR'); + + if (!-f "$upload_dir/$changes_f") { + $self->log("$changes_f does not exist\n"); + return; + } + if (!open( F, "<$upload_dir/$changes_f" )) { + $self->log("Cannot open $upload_dir/$changes_f: $!\n"); + return; + } + { local($/); undef $/; $changes_text = <F>; } + close( F ); + @to_remove = $self->get_files_from_changes( $changes_text ); + + ($upload_f = $changes_f) =~ s/\.changes$/\.upload/; + push( @to_remove, $changes_f, $upload_f ); + + $self->log("Removing files:\n", "@to_remove\n"); + foreach (@to_remove) { + unlink "$upload_dir/$_" + or $self->log("Can't remove $upload_dir/$_: $!\n"); + } +} + +sub append_to_REDO ($$) { + my $self = shift; + my $pkg = shift; + my $dist_config = shift; + my $dist_name = $dist_config->get('DIST_NAME'); + + local( *F ); + + lock_file( "build/REDO" ); + + if (open( F, "build/REDO" )) { + my @pkgs = <F>; + close( F ); + if (grep( /^\Q$pkg\E\s/, @pkgs )) { + $self->log("$pkg is already in REDO -- not rescheduled\n"); + goto unlock; + } + } + + if (open( F, ">>build/REDO" )) { + print F "$pkg $dist_name\n"; + close( F ); + $self->log("Scheduled $pkg for rebuild\n"); + } + else { + $self->set('Mail Error', + $self->get('Mail Error') . + "Can't open build/REDO: $!\n"); + $self->log("Can't open build/REDO: $!\n"); + } + + unlock: + unlock_file( "build/REDO" ); +} + +sub remove_from_REDO ($) { + my $self = shift; + my $pkg = shift; + + local( *F ); + + lock_file( "build/REDO" ); + goto unlock if !open( F, "<build/REDO" ); + my @pkgs = <F>; + close( F ); + if (!open( F, ">build/REDO" )) { + $self->log("Can't open REDO for writing: $!\n", + "Would write: @pkgs\nminus $pkg\n"); + goto unlock; + } + my $done = 0; + foreach (@pkgs) { + if (/^\Q$pkg\E\s/) { + ++$done; + } + else { + print F $_; + } + } + close( F ); + $self->log("Deleted $pkg from REDO list.\n") if $done; + unlock: + unlock_file( "build/REDO" ); + return $done; +} + +sub append_to_SKIP ($) { + my $self = shift; + my $pkg = shift; + + local( *F ); + + return if !open( F, "<build/build-progress" ); + my @lines = <F>; + close( F ); + + if (grep( /^\s*\Q$pkg\E$/, @lines )) { + # pkg is in build-progress, but without a suffix (failed, + # successful, currently building), so it can be skipped + lock_file( "build/SKIP" ); + if (open( F, ">>build/SKIP" )) { + print F "$pkg\n"; + close( F ); + $self->log("Told sbuild to skip $pkg\n"); + } + unlock_file( "build/SKIP" ); + } +} + +sub check_is_outdated ($$) { + my $self = shift; + my $dist_config = shift; + my $package = shift; + my $dist_name = $dist_config->get('DIST_NAME'); + + my %newv; + return 0 if !(%newv = $self->is_outdated( $dist_name, $package )); + + my $have_changes = 1 if $self->get('Mail Body Text') =~ /^---+\s*BEGIN PGP SIGNED MESSAGE/; + + # If we have a changes file, we can see which distributions that + # package is aimed to. Otherwise, we're out of luck because we can't see + # reliably anymore for which distribs the package was for. Let the user + # find out this... + # + # If the package is outdated in all dists we have to consider, + # send a plain error message. If only outdated in some of them, send a + # modified error that tells to send a restricted changes (with + # Distribution: only for those dists where it isn't outdated), or to do + # the action manually, because it would be (wrongly) propagated. + goto all_outdated if !$have_changes; + + my @check_dists = (); + @check_dists = $self->get_dists_from_changes($self->get('Mail Body Text')); + + my @not_outdated = (); + my @outdated = (); + foreach (@check_dists) { + if (!exists $newv{$_}) { + push( @not_outdated, $_ ); + } + else { + push( @outdated, $_ ); + } + } + return 0 if !@outdated; + if (@not_outdated) { + $self->set('Mail Short Error', + $self->get('Mail Short Error') . + "$package ($dist_name) partially outdated ". + "(ok for @not_outdated)\n"); + $self->set('Mail Error', + $self->get('Mail Error') . + "Package $package ($dist_name) is partially outdated.\n". + "The following new versions have appeared in the meantime:\n ". + join( "\n ", map { "$_: $newv{$_}" } keys %newv )."\n\n". + "Please send a .changes for the following distributions only:\n". + " Distribution: ".join( " ", @not_outdated )."\n"); + } + else { + all_outdated: + $self->set('Mail Short Error', + $self->get('Mail Short Error') . + "$package ($dist_name) outdated; new versions ". + join( ", ", map { "$_:$newv{$_}" } keys %newv )."\n"); + $self->set('Mail Error', + $self->get('Mail Error') . + "Package $package ($dist_name) is outdated.\n". + "The following new versions have appeared in the meantime:\n ". + join( "\n ", map { "$_: $newv{$_}" } keys %newv )."\n"); + } + return 1; +} + +sub is_outdated ($$) { + my $self = shift; + my $dist_name = shift; + my $pkg = shift; + + my %result = (); + local( *F ); + + lock_file( "outdated-packages" ); + goto unlock if !open( F, "<outdated-packages" ); + while( <F> ) { + my($oldpkg, $newpkg, $t, $d) = split( /\s+/, $_ ); + $d ||= "unstable"; + if ($oldpkg eq $pkg && $d eq $dist_name) { + $result{$d} = $newpkg; + } + } + close( F ); + unlock: + unlock_file( "outdated-packages" ); + return %result; +} + +sub register_outdated ($$$) { + my $self = shift; + my $dist = shift; + my $oldv = shift; + my $newv = shift; + + my(@pkgs); + local( *F ); + + lock_file( "outdated-packages" ); + + if (open( F, "<outdated-packages" )) { + @pkgs = <F>; + close( F ); + } + + if (!open( F, ">outdated-packages" )) { + $self->log("Cannot open outdated-packages for writing: $!\n"); + goto unlock; + } + my $now = time; + my @d = (); + foreach (@pkgs) { + my($oldpkg, $newpkg, $t, $d) = split( /\s+/, $_ ); + $d ||= "unstable"; + next if ($oldpkg eq $oldv && $d eq $dist) || ($now - $t) > 21*24*60*60; + print F $_; + } + print F "$oldv $newv $now $dist\n"; + close( F ); + unlock: + unlock_file( "outdated-packages" ); +} + +sub set_to_failed ($$$) { + my $self = shift; + my $pkg = shift; + my $dist_config = shift; + my $text = shift; + my $dist_name = $dist_config->get('DIST_NAME'); + + my $is_bugno = 0; + + $text =~ s/^\.$/../mg; + $is_bugno = 1 if $text =~ /^\(see #\d+\)$/; + return if !$self->check_state( $pkg, $dist_config, $is_bugno ? "Failed" : qw(Built Building Build-Attempted BD-Uninstallable) ); + + my $db = $self->get_db_handle($dist_config); + my $pipe = $db->pipe_query_out('--failed', $pkg); + if ($pipe) { + print $pipe "${text}.\n"; + close($pipe); + } + if ($?) { + my $t = "wanna-build --failed failed with status ".exitstatus($?)."\n"; + $self->log($t); + $self->set('Mail Error', + $self->get('Mail Error') . $t); + } elsif ($is_bugno) { + $self->log("Bug# appended to fail message of $pkg ($dist_name)\n"); + } + else { + $self->log("Set package $pkg ($dist_name) to Failed\n"); + $self->write_stats("failed", 1); + } +} + +sub set_to_depwait ($$$) { + my $self = shift; + my $pkg = shift; + my $dist_config = shift; + my $deps = shift; + my $dist_name = $dist_config->get('DIST_NAME'); + + my $db = $self->get_db_handle($dist_config); + my $pipe = $db->pipe_query_out('--dep-wait', $pkg); + if ($pipe) { + print $pipe "$deps\n"; + close($pipe); + } + if ($?) { + my $t = "wanna-build --dep-wait failed with status ".exitstatus($?)."\n"; + $self->log($t); + $self->set('Mail Error', + $self->get('Mail Error') . $t); + } + else { + $self->log("Set package $pkg ($dist_name) to Dep-Wait\nDependencies: $deps\n"); + } + $self->write_stats("dep-wait", 1); +} + +sub give_back ($$) { + my $self = shift; + my $pkg = shift; + my $dist_config = shift; + my $dist_name = $dist_config->get('DIST_NAME'); + + my $answer; + + my $db = $self->get_db_handle($dist_config); + my $pipe = $db->pipe_query('--give-back', $pkg); + if ($pipe) { + $answer = <$pipe>; + close($pipe); + } + if ($?) { + $self->set('Mail Error', + $self->get('Mail Error') . + "wanna-build --give-back failed:\n$answer"); + } + else { + $self->log("Given back package $pkg ($dist_name)\n"); + } +} + +sub no_build ($$) { + my $self = shift; + my $pkg = shift; + my $dist_config = shift; + my $dist_name = $dist_config->get('DIST_NAME'); + my $answer_cmd; + + my $answer; + + my $db = $self->get_db_handle($dist_config); + my $pipe = $db->pipe_query('--no-build', $pkg); + if ($pipe) { + $answer = <$pipe>; + close($pipe); + } + if ($?) { + $self->set('Mail Error', + $self->get('Mail Error') . + "no-build failed:\n$answer"); + } + else { + $self->log("Package $pkg ($dist_name) to set Not-For-Us\n"); + } + $self->write_stats("no-build", 1); +} + +sub get_fail_msg ($$) { + my $self = shift; + my $pkg = shift; + my $dist_config = shift; + my $dist_name = $dist_config->get('DIST_NAME'); + + $pkg =~ s/_.*//; + + my $db = $self->get_db_handle($dist_config); + my $pipe = $db->pipe_query('--info', $pkg); + if ($pipe) { + my $msg = ""; + while(<$pipe>) { + if (/^\s*Old-Failed\s*:/) { + while(<$pipe>) { + last if /^ \S+\s*/; + $_ =~ s/^\s+//; + if (/^----+\s+\S+\s+----+$/) { + last if $msg; + } + else { + $msg .= $_; + } + } + last; + } + } + close($pipe); + return $msg if $msg; + $self->set('Mail Error', + $self->get('Mail Error') . + "Couldn't find Old-Failed in info for $pkg\n"); + return "Same as previous version (couldn't extract the text)\n"; + } else { + $self->set('Mail Error', + $self->get('Mail Error') . + "Couldn't start wanna-build --info: $!\n"); + return "Same as previous version (couldn't extract the text)\n"; + } +} + +sub check_state ($@) { + my $self = shift; + my $mail_error = $self->get('Mail Error'); + my $retval = $self->check_state_internal(@_); + # check if we should retry the call + if ($retval == -1) { + my $interval = int(rand(120)); + $self->log("Retrying --info in $interval seconds...\n"); + # reset error to old value + $self->set('Mail Error', $mail_error); + # 0..120s of sleep ought to be enough for retrying; + # for mail bursts, this should get us out of the + # crticial mass + sleep $interval; + $retval = $self->check_state_internal(@_); + # remap the -1 retry code to failure + if ($retval == -1) { + return 0; + } else { + return $retval; + } + } + return $retval; +} + +sub check_state_internal ($$@) { + my $self = shift; + my $pkgv = shift; + my $dist_config = shift; + my @wanted_states = @_; + my $dist_name = $dist_config->get('DIST_NAME'); + + $pkgv =~ /^([^_]+)_(.+)/; + my ($pkg, $vers) = ($1, $2); + + my $db = $self->get_db_handle($dist_config); + my $pipe = $db->pipe_query('--info', $pkg); + if (!$pipe) { + $self->set('Mail Error', + $self->get('Mail Error') . + "Couldn't start wanna-build --info: $!\n"); + $self->log("Couldn't start wanna-build --info: $!\n"); + # let check_state() retry if needed + return -1; + } + + my ($av, $as, $ab, $an); + while(<$pipe>) { + $av = $1 if /^\s*Version\s*:\s*(\S+)/; + $as = $1 if /^\s*State\s*:\s*(\S+)/; + $ab = $1 if /^\s*Builder\s*:\s*(\S+)/; + $an = $1 if /^\s*Binary-NMU-Version\s*:\s*(\d+)/; + } + close($pipe); + + if ($?) { + my $t = "wanna-build --info failed with status ".exitstatus($?)."\n"; + $self->log($t); + $self->set('Mail Error', + $self->get('Mail Error') . $t); + return 0; + } + + my $msg = "$pkgv($dist_name) check_state(@wanted_states): "; + $av = binNMU_version($av,$an,undef) if (defined $an); + if ($av ne $vers) { + $self->set('Mail Error', + $self->get('Mail Error') . + $msg."version $av registered as $as\n"); + return 0; + } + if (!Buildd::isin( $as, @wanted_states)) { + $self->set('Mail Error', + $self->get('Mail Error') . + $msg."state is $as\n"); + return 0; + } + if ($as eq "Building" && $ab ne $dist_config->get('WANNA_BUILD_DB_USER')) { + $self->set('Mail Error', + $self->get('Mail Error') . + $msg."is building by $ab\n"); + return 0; + } + return 1; +} + +sub check_building_any_dist ($) { + my $self = shift; + my $pkgv = shift; + + my @dists; + + $pkgv =~ /^([^_]+)_(.+)/; + my ($pkg, $vers) = ($1, $2); + + for my $dist_config (@{$self->get_conf('DISTRIBUTIONS')}) { + my $dist_name = $dist_config->get('DIST_NAME'); + + my $db = $self->get_db_handle($dist_config); + my $pipe = $db->pipe_query('--info', $pkg); + if (!$pipe) { + $self->set('Mail Error', + $self->get('Mail Error') . + "Couldn't start wanna-build --info: $!\n"); + return 0; + } + + my $text; + { local ($/); $text = <$pipe>; } + close($pipe); + + while( $text =~ /^\Q$pkg\E\((\w+)\):(.*)\n((\s.*\n)*)/mg ) { + my ($dist, $rest, $info) = ($1, $2, $3); + next if $rest =~ /not registered/; + my ($av, $as, $ab); + $av = $1 if $info =~ /^\s*Version\s*:\s*(\S+)/mi; + $as = $1 if $info =~ /^\s*State\s*:\s*(\S+)/mi; + $ab = $1 if $info =~ /^\s*Builder\s*:\s*(\S+)/mi; + push( @dists, $dist ) + if $av eq $vers && $as eq "Building" && + $ab eq $self->get_conf('WANNA_BUILD_DB_USER'); + } + } + return @dists; +} + +sub get_files_from_changes ($) { + my $self = shift; + my $changes_text = shift; + + my(@filelines, @files); + + $changes_text =~ /^Files:\s*\n((^[ ]+.*\n)*)/m; + @filelines = split( "\n", $1 ); + foreach (@filelines) { + push( @files, (split( /\s+/, $_ ))[5] ); + } + return @files; +} + +sub get_dists_from_changes ($) { + my $self = shift; + my $changes_text = shift; + + $changes_text =~ /^Distribution:\s*(.*)\s*$/mi; + return split( /\s+/, $1 ); +} + +sub get_upload_queue_dirs ($) { + my $self = shift; + my $changes_text = shift; + + my %upload_dirs; + my @dists = $self->get_dists_from_changes( $changes_text ); + for my $dist_config (@{$self->get_conf('DISTRIBUTIONS')}) { + my $upload_dir = $self->get_conf('HOME') . '/' . $dist_config->get('DUPLOAD_LOCAL_QUEUE_DIR'); + + if (grep { $dist_config->get('DIST_NAME') eq $_ } @dists) { + $upload_dirs{$upload_dir} = 1; + } + } + return keys %upload_dirs; +} + +sub find_upload_dirs_for_changes_file ($) { + my $self = shift; + my $changes_file_name = shift; + + my %dirs; + + for my $dist_config (@{$self->get_conf('DISTRIBUTIONS')}) { + my $upload_dir = $self->get_conf('HOME') . '/' . $dist_config->get('DUPLOAD_LOCAL_QUEUE_DIR'); + if (-f "$upload_dir/$changes_file_name") { + $dirs{$upload_dir} = 1; + } + } + + return keys %dirs; +} + +sub reply ($) { + my $self = shift; + my $text = shift; + + my( $to, $subj, $quoting ); + + $to = $self->get('Mail Header')->{'reply-to'} || + $self->get('Mail Header')->{'from'}; + $subj = $self->get('Mail Header')->{'subject'}; + $subj = "Re: $subj" if $subj !~ /^Re\S{0,2}:/; + ($quoting = $self->get('Mail Body Text')) =~ s/\n+$/\n/; + $quoting =~ s/^/> /mg; + + send_mail( $to, $subj, "$text\n$quoting", + "In-Reply-To: ". $self->get('Mail Header')->{'message-id'}. "\n" ); +} + +sub is_blacklisted ($) { + my $self = shift; + my $addr = shift; + + local( *BL ); + + $addr = $1 if $addr =~ /<(.*)>/; + return 0 if !open( BL, "<mail-blacklist" ); + while( <BL> ) { + chomp; + if ($addr =~ /$_$/) { + close( BL ); + return 1; + } + } + close( BL ); + return 0; +} + +sub add_error_mail () { + my $self = shift; + + local( *F ); + my $now = time; + my @em = (); + + if (open( F, "<mail-errormails" )) { + chomp( @em = <F> ); + close( F ); + } + push( @em, $now ); + shift @em while @em && ($now - $em[0]) > $self->get_conf('ERROR_MAIL_WINDOW'); + + if (@em) { + open( F, ">mail-errormails" ); + print F join( "\n", @em ), "\n"; + close( F ); + } + else { + unlink( "mail-errormails" ); + } + + return scalar(@em); +} + +1; diff --git a/lib/Buildd/Makefile.am b/lib/Buildd/Makefile.am new file mode 100644 index 0000000..5b5b930 --- /dev/null +++ b/lib/Buildd/Makefile.am @@ -0,0 +1,42 @@ +# sbuild Makefile template +# +# +# Copyright © 2004-2009 Roger Leigh <rleigh@debian.org> +# +# sbuild 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 3 of the License, or +# (at your option) any later version. +# +# sbuild 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 +# <http://www.gnu.org/licenses/>. +# +##################################################################### + +include $(top_srcdir)/scripts/global.mk + +perlmodbuildddir = $(perlmoddir)/Buildd + +MODULES = \ + Base.pm \ + Client.pm \ + ClientConf.pm \ + Conf.pm \ + DistConf.pm \ + UploadQueueConf.pm \ + Daemon.pm \ + Mail.pm \ + Uploader.pm \ + Watcher.pm + +perlmodbuildd_DATA = \ + $(MODULES) + +EXTRA_DIST = \ + $(MODULES) diff --git a/lib/Buildd/UploadQueueConf.pm b/lib/Buildd/UploadQueueConf.pm new file mode 100644 index 0000000..d0fb1e0 --- /dev/null +++ b/lib/Buildd/UploadQueueConf.pm @@ -0,0 +1,96 @@ +# +# Conf.pm: configuration library for buildd +# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de> +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2006-2009 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Buildd::UploadQueueConf; + +use strict; +use warnings; + +use Sbuild::ConfBase; +use Sbuild::Sysconfig; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter); + + @EXPORT = qw(new_hash setup read_hash); +} + +sub new_hash (@); +sub setup ($); +sub read_hash ($$); + +sub new_hash (@) { + my %opts = @_; + + my $queue_config = Sbuild::ConfBase->new(%opts); + + Buildd::UploadQueueConf::setup($queue_config); + Buildd::UploadQueueConf::read_hash($queue_config, $opts{'HASH'}); + + return $queue_config; +} + +sub setup ($) { + my $conf = shift; + + my $validate_directory_in_home = sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + my $directory = $conf->get($key); + my $home_directory = $conf->get('HOME'); + + die "$key directory is not defined" + if !defined($directory) || !$directory; + + die "$key directory '$home_directory/$directory' does not exist" + if !-d $home_directory . "/" . $directory; + }; + + my %dupload_queue_keys = ( + 'DUPLOAD_LOCAL_QUEUE_DIR' => { + CHECK => $validate_directory_in_home, + DEFAULT => 'upload' + }, + 'DUPLOAD_ARCHIVE_NAME' => { + DEFAULT => 'anonymous-ftp-master' + }, + ); + + $conf->set_allowed_keys(\%dupload_queue_keys); + + Buildd::ClientConf::setup($conf); +} + +sub read_hash ($$) { + my $conf = shift; + my $data = shift; + + for my $key (keys %$data) { + $conf->set($key, $data->{$key}); + } +} + +1; diff --git a/lib/Buildd/Uploader.pm b/lib/Buildd/Uploader.pm new file mode 100644 index 0000000..302f5da --- /dev/null +++ b/lib/Buildd/Uploader.pm @@ -0,0 +1,274 @@ +# buildd-uploader: upload finished packages for buildd +# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de> +# Copyright © 2009 Roger Leigh <rleigh@debian.org> +# Copyright © 2005 Ryan Murray <rmurray@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Buildd::Uploader; + +use strict; +use warnings; + +use Buildd qw(lock_file unlock_file unset_env exitstatus send_mail); +use Buildd::Base; +use Buildd::Conf qw(); + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Buildd::Base); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + + my $self = $class->SUPER::new($conf); + bless($self, $class); + + $self->set('Uploader Lock', undef); + $self->set('Uploaded Pkgs', {}); + + $self->open_log(); + + return $self; +} + +sub run { + my $self = shift; + + unset_env(); + + $self->set('Uploader Lock', + lock_file("$main::HOME/buildd-uploader", 1)); + + if (!$self->get('Uploader Lock')) { + $self->log("exiting; another buildd-uploader is still running"); + return 1; + } + + for my $queue_config (@{$self->get_conf('UPLOAD_QUEUES')}) { + $self->upload( + $queue_config->get('DUPLOAD_LOCAL_QUEUE_DIR'), + $queue_config->get('DUPLOAD_ARCHIVE_NAME')); + } + + my $uploaded_pkgs = $self->get('Uploaded Pkgs'); + + foreach my $archdist (keys %{$uploaded_pkgs}) { + $self->log("Set to Uploaded($archdist):$uploaded_pkgs->{$archdist}"); + } + + return 0; +} + +sub uploaded ($@) { + my $self = shift; + my $pkg = shift; + my $arch_name = shift; + my $dist_name = shift; + + my $msgs = ""; + + my $dist_config = $self->get_arch_dist_config_by_name($arch_name, $dist_name); + my $db = $self->get_db_handle($dist_config); + + my $pipe = $db->pipe_query('--uploaded', $pkg); + + if ($pipe) { + while(<$pipe>) { + if (!/^(\S+): Propagating new state /) { + $msgs .= $_; + } + } + close($pipe); + if ($msgs or $?) { + $self->log($msgs) if $msgs; + $self->log("wanna-build --uploaded failed with status ", + exitstatus($?), "\n" ) + if $?; + } else { + my $archdist_name = "$arch_name/$dist_name"; + $self->get('Uploaded Pkgs')->{$archdist_name} .= " $pkg"; + } + } else { + $self->log("Can't spawn wanna-build --uploaded: $!\n"); + } +} + +sub upload ($$) { + my $self = shift; + my $udir = shift; + my $upload_to = shift; + + chdir( "$main::HOME/$udir" ) || return; + lock_file( "$main::HOME/$udir" ); + + my( $f, $g, @before, @after ); + + foreach $f (<*.changes>) { + ($g = $f) =~ s/\.changes$/\.upload/; + push( @before, $f ) if ! -f $g; + } + + unlock_file( "$main::HOME/$udir" ); + + if (!@before) { + $self->log("Nothing to do for $udir\n"); + return; + } + + $self->log(scalar(@before), " jobs to upload in $udir: @before\n"); + + foreach $f (@before) { + ($g = $f) =~ s/\.changes$/\.upload/; + my $logref = $self->do_dupload( $upload_to, $f ); + + if (defined $logref and scalar(@$logref) > 0) { + my $line; + + foreach $line (@$logref) { + $self->log($line); + } + } + + if ( -f $g ) { + if (!open( F, "<$f" )) { + $self->log("Cannot open $f: $!\n"); + next; + } + my $text; + { local($/); undef $/; $text = <F>; } + close( F ); + if ($text !~ /^Architecture:\s*(.*)\s*$/m) { + $self->log("$f doesn't have a Architecture: field\n"); + next; + } + my @archs = split( /\s+/, $1 ); + if ($text !~ /^Distribution:\s*(.*)\s*$/m) { + $self->log("$f doesn't have a Distribution: field\n"); + next; + } + my @dists = split( /\s+/, $1 ); + my ($version,$source,$pkg); + if ($text =~ /^Version:\s*(\S+)\s*$/m) { + $version = $1; + } + if ($text =~ /^Source:\s*(\S+)(?:\s+\(\S+\))?\s*$/m) { + $source = $1; + } + if (defined($version) and defined($source)) { + $pkg = "${source}_$version"; + } else { + ($pkg = $f) =~ s/_\S+\.changes$//; + } + $self->uploaded($pkg, @archs, @dists); + } else { + push (@after, $f); + } + } + + if (@after) { + $self->log("The following jobs were not processed (successfully):\n" . + "@after\n"); + } + else { + $self->log("dupload successful.\n"); + } + $self->write_stats("uploads", scalar(@before) - scalar(@after)); +} + +sub do_dupload ($@) { + my $self = shift; + my $upload_to = shift; + + my @jobs = @_; + my @log; + local( *PIPE ); + my( $current_job, $current_file, @failed, $errs ); + + if (!open( PIPE, "dupload -k --to $upload_to @jobs </dev/null 2>&1 |" )) { + return "Cannot spawn dupload: $!"; + } + + my $dup_log = ""; + while( <PIPE> ) { + $dup_log .= $_; + chomp; + if (/^\[ job \S+ from (\S+\.changes)$/) { + $current_job = $1; + } + elsif (/^warning: MD5sum mismatch for (\S+), skipping/i) { + my $f = $1; + push( @log, "dupload error: md5sum mismatch for $f\n" ); + $errs .= "md5sum mismatch on file $f ($current_job)\n"; + push( @failed, $current_job ); + } + elsif (/^\[ Uploading job (\S+)$/) { + $current_job = "$1.changes"; + } + elsif (/dupload fatal error: Can't upload (\S+)/i || + /^\s(\S+).*scp: (.*)$/) { + my($f, $e) = ($1, $2); + push( @log, "dupload error: upload error for $f\n" ); + push( @log, "($e)\n" ) if $e; + $errs .= "upload error on file $f ($current_job)\n"; + push( @failed, $current_job ); + } + elsif (/Timeout at [\S]+ line [\d]+$/) { + $errs .= "upload timeout on file $current_job\n"; + push( @failed, $current_job ); + } + elsif (/^\s(\S+)\s+[\d.]+ kB /) { + $current_file = $1; + } + } + close( PIPE ); + if ($?) { + if (($? >> 8) == 141) { + push( @log, "dupload error: SIGPIPE (broken connection)\n" ); + $errs .= "upload error (broken connection) during ". + "file $current_file ($current_job)\n"; + push( @failed, $current_job ); + } + else { + push( @log, "dupload exit status ". exitstatus($?) ); + $errs .= "dupload exit status ".exitstatus($?)."\n"; + push( @failed, $current_job ); + } + } + + foreach (@failed) { + my $u = $_; + $u =~ s/\.changes$/\.upload/; + unlink( $u ); + push( @log, "Removed $u due to upload errors.\n" ); + $errs .= "Removed $u to reupload later.\n"; + } + + if ($errs) { + $errs .= "\nComplete output from dupload:\n\n$dup_log"; + send_mail($self->get_conf('ADMIN_MAIL'), "dupload errors", $errs); + } + return \@log; +} + +1; diff --git a/lib/Buildd/Watcher.pm b/lib/Buildd/Watcher.pm new file mode 100644 index 0000000..fd83d4e --- /dev/null +++ b/lib/Buildd/Watcher.pm @@ -0,0 +1,528 @@ +# buildd-watcher: +# Copyright © 1998 Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de> +# Copyright © 2009 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Buildd::Watcher; + +use strict; +use warnings; +use Buildd qw(send_mail lock_file unlock_file unset_env); +use Buildd::Conf qw(); +use Buildd::Base; + +use POSIX qw(ESRCH LONG_MAX); +use Cwd; + +sub ST_MTIME () { 9 } + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Buildd::Base); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + + my $self = $class->SUPER::new($conf); + bless($self, $class); + + $self->set('Fudge', 1/24/6); # 10 minutes in units of a day + $self->set('Graph Maxval', { + 'builds-per-day' => 100, + 'uploads-per-day' => 100, + 'failed-per-day' => 50, + 'dep-wait-per-day' => 50, + 'give-back-per-day' => 50, + 'time-per-build' => 10*60*60, + 'build-time-percent' => 1, + 'idle-time-percent' => 1}); + + $self->open_log(); + + return $self; +} + +sub run { + my $self = shift; + + unset_env(); + chdir($self->get_conf('HOME')); + +# check if another watcher is still running + my $watcher_pid; + if (open( PID, "<watcher-running")) { + $watcher_pid = <PID>; + close( PID ); + $watcher_pid =~ /^\s*(\d+)/; $watcher_pid = $1; + if (!$watcher_pid || (kill( 0, $watcher_pid ) == 0 && $! == ESRCH)) { + $self->log("Ignoring stale watcher-running file (pid $watcher_pid).\n"); + } + else { + $self->log("Another buildd-watcher is still running ". + "(pid $watcher_pid) -- exiting.\n"); + return 0; + } + } + open( F, ">watcher-running.new" ) + or die "Can't create watcher-running.new: $!\n"; + printf F "%5d\n", $$; + close( F ); + rename( "watcher-running.new", "watcher-running" ) + or die "Can't rename watcher-running.new: $!\n"; + +# check if buildd is still running, restart it if needed. + my $restart = 0; + my $daemon_pid; + if (open( PID, "<" . $self->get_conf('PIDFILE') )) { + $daemon_pid = <PID>; + close( PID ); + $daemon_pid =~ /^\s*(\d+)/; $daemon_pid = $1; + if (!$daemon_pid || (kill( 0, $daemon_pid ) == 0 && $! == ESRCH)) { + $self->log("pid file exists, but process $daemon_pid doesn't exist.\n"); + $restart = 1; + } + } + else { + $self->log("daemon not running (no pid file).\n"); + $restart = 1; + } + +# do dir-purges that buildd-mail can't do (is running as nobody, so no sudo) + lock_file( "build/PURGE" ); + my @to_purge = (); + if (open( F, "<build/PURGE" )) { + @to_purge = <F>; + close( F ); + unlink( "build/PURGE" ); + chomp( @to_purge ); + } + unlock_file( "build/PURGE" ); + + foreach (@to_purge) { + next if ! -d $_; + system(qw(sudo rm -rf --), $_); + $self->log("Purged $_\n"); + } + +# cut down mail-errormails file + my $now = time; + my @em = (); + if (open( F, "<mail-errormails" )) { + chomp( @em = <F> ); + close( F ); + } + shift @em while @em && ($now - $em[0]) > $self->get_conf('ERROR_MAIL_WINDOW'); + if (@em) { + open( F, ">mail-errormails" ); + print F join( "\n", @em ), "\n"; + close( F ); + } + else { + unlink( "mail-errormails" ); + } + +# check for old stuff in build and upload dirs + my %warnfile; + my $file; + my $dev; + my $ino; + foreach $file (<upload/*>) { + ($dev,$ino) = lstat $file; + $warnfile{"$dev:$ino"} = $file if -M $file >= $self->get_conf('WARNING_AGE'); + } + # TODO: Glob is incompatible with modern sbuild, which doesn't use + # separate user directories. + my $username = $self->get_conf('USERNAME'); + foreach $file (<build/chroot-*/build/$username/*>) { + ($dev,$ino) = lstat $file; + if (! -d _ && ! -l _) { + $warnfile{"$dev:$ino"} = $file if -C _ >= $self->get_conf('WARNING_AGE'); + } + else { + my $warnage = $self->get_conf('WARNING_AGE'); + my $changed_files = + `find $file -ctime -$warnage -print 2>/dev/null`; + $warnfile{"$dev:$ino"} = $file if !$changed_files; + } + } + foreach $file (<build/*>) { + next if $file =~ m#^build/chroot-[^/]+$#; + ($dev,$ino) = lstat $file; + if (! -d _ && ! -l _) { + $warnfile{"$dev:$ino"} = $file if -C _ >= $self->get_conf('WARNING_AGE'); + } + else { + my $warnage = $self->get_conf('WARNING_AGE'); + my $changed_files = + `find $file -ctime -$warnage -print 2>/dev/null`; + $warnfile{"$dev:$ino"} = $file if !$changed_files; + } + } + my $nowarnpattern = $self->get_conf('NO_WARN_PATTERN'); + my @warnings = grep( !/$nowarnpattern/, sort values %warnfile ); + if (@warnings) { + my %reported; + my @do_warn; + if (open( W, "<reported-old-files" )) { + while( <W> ) { + next if !/^(\S+)\s+(\d+)$/; + $reported{$1} = $2; + } + close( W ); + } + + foreach (@warnings) { + if (!exists($reported{$_}) || + ($now - $reported{$_}) >= $self->get_conf('WARNING_AGE')*24*60*60) { + push( @do_warn, $_ ); + $reported{$_} = $now; + } + } + + my $old_umask = umask 007; + open( W, ">reported-old-files" ) + or die "Can't create/write reported-old-files: $!\n"; + foreach (keys %reported) { + print W "$_ $reported{$_}\n" if -e $_ || -l $_; + } + close( W ); + umask $old_umask; + + send_mail( $self->get_conf('ADMIN_MAIL'), "buildd-watcher found some old files", + "buildd-watcher has found some old files or directories in\n". + "~buildd/upload and/or ~buildd/build. Those are:\n\n ". + join( "\n ", @do_warn ). "\n\n". + "Please have a look at them and remove them if ". + "they're obsolete.\n" ) + if @do_warn; + } + +# archive old package/build log files + $self->archive_logs( "logs", "*", "old-logs/plog", $self->get_conf('PKG_LOG_KEEP') ); + $self->archive_logs( "build", "build-*.log", "old-logs/blog", $self->get_conf('BUILD_LOG_KEEP') ); + +# rotate daemon's log file + if (!-f "old-logs/daemon-stamp" || + -M "old-logs/daemon-stamp" > $self->get_conf('DAEMON_LOG_ROTATE')-$self->get('Fudge')) { + + $self->log("Rotating daemon log file\n"); + system(qw(touch old-logs/daemon-stamp)); + + my $d = $self->format_time(time); + if (-f $self->get_conf('DAEMON_LOG_FILE') . ".old") { + system(qw(mv --), $self->get_conf('DAEMON_LOG_FILE') . '.old', "old-logs/daemon-$d.log"); + system(qw(gzip -9), "old-logs/daemon-$d.log"); + } + + rename( $self->get_conf('DAEMON_LOG_FILE'), + $self->get_conf('DAEMON_LOG_FILE') . ".old" ); + my $old_umask = umask 0007; + system(qw(touch --), $self->get_conf('DAEMON_LOG_FILE')); + umask $old_umask; + kill( 1, $daemon_pid ) if $daemon_pid; + $self->reopen_log(); + + if ($self->get_conf('DAEMON_LOG_SEND')) { + my $text; + open( F, "<" . $self->get_conf('DAEMON_LOG_FILE') . ".old" ); + { local($/); undef $/; $text = <F>; } + close( F ); + send_mail( $self->get_conf('ADMIN_MAIL'), "Build Daemon Log $d", $text ); + } + } + $self->archive_logs( "old-logs", "daemon-*.log.gz", "old-logs/dlog", $self->get_conf('DAEMON_LOG_KEEP') ); + +# make buildd statistics + if (!-f "stats/Stamp" || + -M "stats/Stamp" > $self->get_conf('STATISTICS_PERIOD')-$self->get('Fudge')) { + + $self->log("Making buildd statistics\n"); + lock_file( "stats" ); + my $lasttime = 0; + if (open( F, "<stats/Stamp" )) { + chomp( $lasttime = <F> ); + close( F ); + } + my $now = time; + + $self->make_statistics( $lasttime, $now ); + + open( F, ">stats/Stamp" ); + print F "$now\n"; + close( F ); + unlock_file( "stats" ); + + my $text; + open( F, "<stats/Summary" ); + { local($/); undef $/; $text = <F>; } + close( F ); + send_mail( $self->get_conf('STATISTICS_MAIL'), "Build Daemon Statistics", $text ); + } + + if ($restart) { + if (-f "NO-DAEMON-PLEASE") { + $self->log("NO-DAEMON-PLEASE exists, not starting daemon\n"); + } + else { + $self->close_log(); + unlink ("watcher-running"); + exec "buildd"; + } + } + + unlink ("watcher-running"); + return 0; +} + +sub archive_logs ($$$$) { + my $self = shift; + my $dir = shift; + my $pattern = shift; + my $destpat = shift; + my $minage = shift; + + my( $olddir, $file, @todo, $oldest, $newest, $oldt, $newt ); + + return if -f "$destpat-stamp" && -M "$destpat-stamp" < $minage-$self->get('Fudge'); + $self->log("Archiving logs in $dir:\n"); + system(qw(touch --), "$destpat-stamp"); + + $olddir = cwd; + chdir( $dir ); + + $oldest = LONG_MAX; + $newest = 0; + foreach $file (glob($pattern)) { + if (-M $file >= $minage) { + push( @todo, $file ); + my $modtime = (stat(_))[ST_MTIME]; + $oldest = $modtime if $oldest > $modtime; + $newest = $modtime if $newest < $modtime; + } + } + if (@todo) { + $oldt = $self->format_time($oldest); + $newt = $self->format_time($newest); + $file = $self->get_conf('HOME') . "/$destpat-$oldt-$newt.tar"; + + system(qw(tar cf), $file, '--', @todo); + system(qw(gzip -9 --), $file); + + if ($dir eq "logs") { + local (*F); + my $index = $self->get_conf('HOME') . "/$destpat-$oldt-$newt.index"; + if (open( F, ">$index" )) { + print F join( "\n", @todo ), "\n"; + close( F ); + } + } + + unlink( @todo ); + $self->log("Archived ", scalar(@todo), " files from $oldt to $newt\n"); + } + else { + $self->log("No files to archive\n"); + } + + chdir( $olddir ); +} + +sub make_statistics ($$) { + my $self = shift; + my $start_time = shift; + my $end_time = shift; + + my @svars = qw(taken builds uploads failed dep-wait no-build + give-back idle-time build-time remove-time + install-download-time); + my ($s_taken, $s_builds, $s_uploads, $s_failed, $s_dep_wait, + $s_no_build, $s_give_back, $s_idle_time, $s_build_time, + $s_remove_time, $s_install_download_time); + local( *F, *G, *OUT ); + + my $var; + foreach $var (@svars) { + my $svar = "s_$var"; + $svar =~ s/-/_/g; + eval "\$$svar = 0;"; + if (-f "stats/$var") { + if (!open( F, "<stats/$var" )) { + $self->log("can't open stats/$var: $!\n"); + next; + } + my $n = 0; + while( <F> ) { + chomp; + $n += $_; + } + close( F ); + eval "\$$svar = $n;"; + unlink( "stats/$var" ); + } + } + + my $total_time = $end_time - $start_time; + my $days = $total_time / (24*60*60); + + if (!open( OUT, ">stats/Summary" )) { + $self->log("Can't create stats/Summary: $!\n"); + return; + } + + printf OUT "Build daemon statistics from %s to %s (%3.2f days):\n\n", + $self->format_time($start_time), $self->format_time($end_time), $days; + + print OUT " #packages % of taken pkgs/day\n"; + print OUT "-------------------------------------------\n"; + printf OUT "taken : %5d %7.2f\n", + $s_taken, $s_taken/$days; + printf OUT "builds : %5d %7.2f%% %7.2f\n", + $s_builds, $s_taken ? $s_builds*100/$s_taken : 0, $s_builds/$days; + printf OUT "uploaded : %5d %7.2f%% %7.2f\n", + $s_uploads, $s_taken ? $s_uploads*100/$s_taken : 0, $s_uploads/$days; + printf OUT "failed : %5d %7.2f%% %7.2f\n", + $s_failed, $s_taken ? $s_failed*100/$s_taken : 0, $s_failed/$days; + printf OUT "dep-wait : %5d %7.2f%% %7.2f\n", + $s_dep_wait, $s_taken ? $s_dep_wait*100/$s_taken : 0, $s_dep_wait/$days; + printf OUT "give-back: %5d %7.2f%% %7.2f\n", + $s_give_back, $s_taken ? $s_give_back*100/$s_taken : 0, $s_give_back/$days; + printf OUT "no-build : %5d %7.2f%% %7.2f\n", + $s_no_build, $s_taken ? $s_no_build*100/$s_taken : 0, $s_no_build/$days; + print OUT "\n"; + + print OUT " time % of total\n"; + print OUT "----------------------------------\n"; + printf OUT "building: %s %7.2f%%\n", + $self->print_time($s_build_time), $s_build_time*100/$total_time; + printf OUT "install : %s %7.2f%%\n", + $self->print_time($s_install_download_time), $s_install_download_time*100/$total_time; + printf OUT "removing: %s %7.2f%%\n", + $self->print_time($s_remove_time), $s_remove_time*100/$total_time; + printf OUT "idle : %s %7.2f%%\n", + $self->print_time($s_idle_time), $s_idle_time*100/$total_time; + printf OUT "total : %s\n", $self->print_time($total_time); + print OUT "\n"; + + my $proc = $s_uploads+$s_failed+$s_dep_wait+$s_no_build+$s_give_back; + printf OUT "processed package (upl+fail+dep+nob): %7d\n", $proc; + printf OUT "slipped (proc-taken) : %7d\n", $proc-$s_taken; + printf OUT "builds/taken package : %7.2f\n", + $s_builds/$s_taken + if $s_taken; + printf OUT "avg. time/taken package : %s\n", + $self->print_time($s_build_time/$s_taken) + if $s_taken; + printf OUT "avg. time/processed package : %s\n", + $self->print_time($s_build_time/$proc) + if $proc; + printf OUT "avg. time/build : %s\n", + $self->print_time($s_build_time/$s_builds) + if $s_builds; + print OUT "\n"; + + my $date = $self->format_date(time); + $self->print_graph( $s_builds/$days, $date, "builds-per-day" ); + $self->print_graph( $s_uploads/$days, $date, "uploads-per-day" ); + $self->print_graph( $s_failed/$days, $date, "failed-per-day" ); + $self->print_graph( $s_dep_wait/$days, $date, "dep-wait-per-day" ); + $self->print_graph( $s_give_back/$days, $date, "give-back-per-day" ); + $self->print_graph( $s_build_time/$s_builds, $date, "time-per-build" ) + if $s_builds; + $self->print_graph( $s_build_time/$total_time, $date, "build-time-percent" ); + $self->print_graph( $s_idle_time/$total_time, $date, "idle-time-percent" ); + + my $g; + my $graph_maxval = $self->get('Graph Maxval'); + + foreach $g (keys %{$graph_maxval}) { + next if !open( G, "<stats/graphs/$g" ); + + print OUT "$g (max. $graph_maxval->{$g}):\n\n"; + while( <G> ) { + print OUT $_; + } + close( G ); + print OUT "\n"; + } + + close( OUT ); +} + +sub print_time ($) { + my $self = shift; + my $t = shift; + + my $str = sprintf "%02d:%02d:%02d", int($t/3600), int(($t%3600)/60), + int($t%60); + $str = " "x(10-length($str)) . $str; + + return $str; +} + +sub print_graph ($$$) { + my $self = shift; + my $val = shift; + my $date = shift; + my $graph = shift; + + my $width = 72; + local( *G ); + + my $graph_maxval = $self->get('Graph Maxval'); + if (!exists $graph_maxval->{$graph}) { + $self->log("Unknown graph $graph\n"); + return; + } + if (!open( G, ">>stats/graphs/$graph" )) { + $self->log("Can't create stats/graphs/$graph: $!\n"); + return; + } + $val = int( $val*$width/$graph_maxval->{$graph} + 0.5 ); + my $str = $val > $width ? "*"x($width-1)."+" : "*"x$val; + $date = substr( $date, 0, 6 ); + $date .= " " x (6-length($date)); + print G "$date $str\n"; + close( G ); +} + +sub format_time ($) { + my $self = shift; + my $t = shift; + + my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = localtime($t); + + return sprintf "%04d%02d%02d-%02d%02d", + $year+1900, $mon+1, $mday, $hour, $min; +} + +sub format_date ($) { + my $self = shift; + my $t = shift; + + my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday) = localtime($t); + + return sprintf "%02d%02d%02d", $year%100, $mon+1, $mday; +} + +1; diff --git a/lib/Makefile.am b/lib/Makefile.am new file mode 100644 index 0000000..f0da554 --- /dev/null +++ b/lib/Makefile.am @@ -0,0 +1,31 @@ +# sbuild Makefile template +# +# +# Copyright © 2004-2007 Roger Leigh <rleigh@debian.org> +# +# sbuild 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 3 of the License, or +# (at your option) any later version. +# +# sbuild 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 +# <http://www.gnu.org/licenses/>. +# +##################################################################### + +include $(top_srcdir)/scripts/global.mk + +SUBDIRS = Buildd Sbuild + +perlmod_DATA = \ + Buildd.pm \ + Sbuild.pm + +EXTRA_DIST = \ + $(perlmod_DATA) diff --git a/lib/Sbuild.pm b/lib/Sbuild.pm new file mode 100644 index 0000000..d4ddf52 --- /dev/null +++ b/lib/Sbuild.pm @@ -0,0 +1,454 @@ +# +# Sbuild.pm: library for sbuild +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2005-2008 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild; + +use Sbuild::Sysconfig; + +use strict; +use warnings; +use POSIX; +use FileHandle; +use Filesys::Df qw(); +use Time::Local; +use IO::Zlib; +use MIME::Base64; +use Dpkg::Control; +use Dpkg::Checksums; +use POSIX qw(locale_h); + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter); + + @EXPORT = qw($debug_level $devnull binNMU_version parse_date isin + copy dump_file check_packages help_text version_text + usage_error send_mail debug debug2 df + check_group_membership dsc_files dsc_pkgver shellescape strftime_c); +} + +our $devnull; +our $debug_level = 0; + +BEGIN { + # A file representing /dev/null + if (!open($devnull, '+<', '/dev/null')) { + die "Cannot open /dev/null: $!\n";; + } +} + +sub binNMU_version ($$$); +sub parse_date ($); +sub isin ($@); +sub copy ($); +sub dump_file ($); +sub check_packages ($$); +sub help_text ($$); +sub version_text ($); +sub usage_error ($$); +sub debug (@); +sub debug2 (@); +sub check_group_membership(); +sub dsc_files ($); +sub shellescape ($); +sub strftime_c ($@); + +sub binNMU_version ($$$) { + my $v = shift; + my $binNMUver = shift; + my $append_to_version = shift; + + my $ver = $v; + if (defined($append_to_version) && $append_to_version) { + $ver .= $append_to_version; + } + if (defined($binNMUver) && $binNMUver) { + $ver .= "+b$binNMUver"; + } + return $ver; +} + +my %monname = ('jan', 0, 'feb', 1, 'mar', 2, 'apr', 3, 'may', 4, 'jun', 5, + 'jul', 6, 'aug', 7, 'sep', 8, 'oct', 9, 'nov', 10, 'dec', 11 ); + +sub parse_date ($) { + my $text = shift; + + return 0 if !$text; + die "Cannot parse date: $text\n" + if $text !~ /^(\d{4}) (\w{3}) (\d+) (\d{2}):(\d{2}):(\d{2})$/; + my ($year, $mon, $day, $hour, $min, $sec) = ($1, $2, $3, $4, $5, $6); + $mon =~ y/A-Z/a-z/; + die "Invalid month name $mon" if !exists $monname{$mon}; + $mon = $monname{$mon}; + return timegm($sec, $min, $hour, $day, $mon, $year); +} + +sub isin ($@) { + my $val = shift; + return grep( $_ eq $val, @_ ); +} + +sub copy ($) { + my $r = shift; + my $new; + + if (ref($r) eq "HASH") { + $new = { }; + foreach (keys %$r) { + $new->{$_} = copy($r->{$_}); + } + } + elsif (ref($r) eq "ARRAY") { + my $i; + $new = [ ]; + for( $i = 0; $i < @$r; ++$i ) { + $new->[$i] = copy($r->[$i]); + } + } + elsif (!ref($r)) { + $new = $r; + } + else { + die "unknown ref type in copy\n"; + } + + return $new; +} + +sub dump_file ($) { + my $file = shift; + + if (-r "$file" && + open(SOURCES, "<$file")) { + + print " +------------------------------------------------------------------------\n"; + while (<SOURCES>) { + chomp; + print " |$_\n"; + } + print " +------------------------------------------------------------------------\n"; + close(SOURCES) or print "Failed to close $file\n"; + } else { + print "W: Failed to open $file\n"; + } +} + +# set and list saved package list (used by sbuild-checkpackages) +sub check_packages ($$) { + my $session = shift; + my $mode = shift; + + my $package_checklist = $session->get_conf('PACKAGE_CHECKLIST'); + my $chroot_dir = $session->get('Location'); + + my (@status, @ref, @install, @remove); + + my $pipe = $session->pipe_command({ + COMMAND => ['dpkg-query', '--show', '--showformat=${Package} ${db:Status-Status}\n'] + }); + while (<$pipe>) { + chomp; + my @token = split / /, $_; + my $pkgname = shift @token; + my $state = shift @token; + next if $state ne "installed"; + push @status, $pkgname; + } + if (! close $pipe) { + print STDERR "Error reading dpkg status file in chroot: $!\n"; + return 1; + } + @status = sort @status; + if (!@status) { + print STDERR "dpkg status file is empty\n"; + return 1; + } + + if ($mode eq "set") { + if (! open WREF, "> $chroot_dir/$package_checklist") { + print STDERR "Can't write reference status file $chroot_dir/$package_checklist: $!\n"; + return 1; + } + foreach (@status) { + print WREF "$_\n"; + } + if (! close WREF) { + print STDERR "Error writing reference status file: $!\n"; + return 1; + } + } else { # "list" + if (! open REF, "< $chroot_dir/$package_checklist") { + print STDERR "Can't read reference status file $chroot_dir/$package_checklist: $!\n"; + return 1; + } + while (<REF>) { + chomp; + push @ref, $_; + } + if (! close REF) { + print STDERR "Error reading reference status file: $!\n"; + return 1; + } + + @ref = sort @ref; + if (!@ref) { + print STDERR "Reference status file is empty\n"; + return 1; + } + + print "DELETE ADD\n"; + print "--------------------------------------\n"; + my $i = 0; + my $j = 0; + + while ($i < scalar @status && $j < scalar @ref) { + + my $c = $status[$i] cmp $ref[$j]; + if ($c < 0) { + # In status, not reference; remove. + print "$status[$i]\n"; + $i++; + } elsif ($c > 0) { + # In reference, not status; install. + print " $ref[$j]\n"; + $j++; + } else { + # Identical; skip. + $i++; $j++; + } + } + + # Print any remaining elements + while ($i < scalar @status) { + print "$status[$i]\n"; + $i++; + } + while ($j < scalar @ref) { + print " $ref[$j]\n"; + $j++; + } + } +} + +sub help_text ($$) { + my $section = shift; + my $page = shift; + + system('man', '--', $section, $page); + exit 0; +} + +sub version_text ($) { + my $program = shift; + + print <<"EOF"; +$program (Debian sbuild) $Sbuild::Sysconfig::version ($Sbuild::Sysconfig::release_date) + +Written by Roman Hodek, James Troup, Ben Collins, Ryan Murray, Rick +Younie, Francesco Paolo Lovergine, Michael Banck, Roger Leigh and +Andres Mejia. + +Copyright © 1998-2000 Roman Hodek <roman\@hodek.net> + © 1998-1999 James Troup <troup\@debian.org> + © 2003-2006 Ryan Murray <rmurray\@debian.org> + © 2001-2003 Rick Younie <younie\@debian.org> + © 2003-2004 Francesco Paolo Lovergine <frankie\@debian.org> + © 2005 Michael Banck <mbanck\@debian.org> + © 2005-2010 Roger Leigh <rleigh\@debian.org> + © 2009-2010 Andres Mejia <mcitadel\@gmail.com> + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +EOF + exit 0; +} + +# Print an error message about incorrect command-line options +sub usage_error ($$) { + my $program = shift; + my $message = shift; + + print STDERR "E: $message\n"; + print STDERR "I: Run '$program --help' to list usage example and all available options\n"; + exit 1; +} + +sub send_mail ($$$$) { + my $conf = shift; + my $to = shift; + my $subject = shift; + my $file = shift; + local( *MAIL, *F ); + + if (!open( F, "<$file" )) { + warn "Cannot open $file for mailing: $!\n"; + return 0; + } + local $SIG{'PIPE'} = 'IGNORE'; + + if (!open( MAIL, "|" . $conf->get('MAILPROG') . " -oem $to" )) { + warn "Could not open pipe to " . $conf->get('MAILPROG') . ": $!\n"; + close( F ); + return 0; + } + + print MAIL "From: " . $conf->get('MAILFROM') . "\n"; + print MAIL "To: $to\n"; + print MAIL "Subject: $subject\n"; + print MAIL "Content-Type: text/plain; charset=UTF-8\n"; + print MAIL "Content-Transfer-Encoding: 8bit\n"; + print MAIL "\n"; + while( <F> ) { + print MAIL "." if $_ eq ".\n"; + print MAIL $_; + } + + close( F ); + if (!close( MAIL )) { + warn $conf->get('MAILPROG') . " failed (exit status $?)\n"; + return 0; + } + return 1; +} + +# Note: split to stderr +sub debug (@) { + + # TODO: Add debug level checking. + if ($debug_level) { + print STDERR "D: ", @_; + } +} + +sub debug2 (@) { + + # TODO: Add debug level checking. + if ($debug_level && $debug_level >= 2) { + print STDERR "D2: ", @_; + } +} + +sub df { + my $dir = shift; + + my $stat = Filesys::Df::df($dir); + + return $stat->{bfree} if (defined($stat)); + +# This only happens if $dir was not a valid file or directory. + return 0; +} + +sub check_group_membership () { + # Skip for root + return if ($< == 0); + + my $user = getpwuid($<); + my ($name,$passwd,$gid,$members) = getgrnam("sbuild"); + + if (!$gid) { + die "Group sbuild does not exist"; + } + + my $in_group = 0; + my @groups = getgroups(); + push @groups, getgid(); + foreach (@groups) { + ($name, $passwd, $gid, $members) = getgrgid($_); + $in_group = 1 if defined($name) && $name eq 'sbuild'; + } + + if (!$in_group) { + print STDERR "User $user is not currently an effective member of group sbuild. Please run:\n"; + print STDERR " sudo sbuild-adduser $user\n"; + print STDERR "And then either log out and log in again or use `newgrp sbuild` to gain sbuild group privileges\n"; + exit(1); + } + + return; +} + +sub dsc_files ($) { + my $dsc = shift; + + debug("Parsing $dsc\n"); + my $pdsc = Dpkg::Control->new(type => CTRL_PKG_SRC); + $pdsc->set_options(allow_pgp => 1); + if (!$pdsc->load($dsc)) { + print STDERR "Could not parse $dsc\n"; + return undef; + } + + my $csums = Dpkg::Checksums->new(); + $csums->add_from_control($pdsc, use_files_for_md5 => 1); + return $csums->get_files(); +} + +sub dsc_pkgver ($) { + my $dsc = shift; + + debug("Parsing $dsc\n"); + my $pdsc = Dpkg::Control->new(type => CTRL_PKG_SRC); + $pdsc->set_options(allow_pgp => 1); + if (!$pdsc->load($dsc)) { + print STDERR "Could not parse $dsc\n"; + return undef; + } + + return ($pdsc->{'Source'}, $pdsc->{'Version'}); +} + +# avoid dependency on String::ShellQuote by implementing the mechanism +# from python's shlex.quote function +sub shellescape ($) { + my $string = shift; + if (length $string == 0) { + return "''"; + } + # search for occurrences of characters that are not safe + # the 'a' regex modifier makes sure that \w only matches ASCII + if ($string !~ m/[^\w@\%+=:,.\/-]/a) { + return $string; + } + # wrap the string in single quotes and handle existing single quotes by + # putting them outside of the single-quoted string + $string =~ s/'/'"'"'/g; + return "'$string'"; +}; + +# this function uses strftime to format a timestamp as a string but makes sure +# to use the C locale to do so instead of the system locale +sub strftime_c ($@) { + my $format = shift; + my @time = @_; + + my $old_locale = setlocale(LC_TIME); + setlocale(LC_TIME, "C.UTF-8"); + my $ret = strftime $format, @time; + setlocale(LC_TIME, $old_locale); + + return $ret; +} + +1; diff --git a/lib/Sbuild/.gitignore b/lib/Sbuild/.gitignore new file mode 100644 index 0000000..4394f55 --- /dev/null +++ b/lib/Sbuild/.gitignore @@ -0,0 +1 @@ +Sysconfig.pm diff --git a/lib/Sbuild/AptResolver.pm b/lib/Sbuild/AptResolver.pm new file mode 100644 index 0000000..c5293a8 --- /dev/null +++ b/lib/Sbuild/AptResolver.pm @@ -0,0 +1,219 @@ +# ResolverBase.pm: build library for sbuild +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2005-2008 Roger Leigh <rleigh@debian.org> +# Copyright © 2008 Simon McVittie <smcv@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::AptResolver; + +use strict; +use warnings; + +use Sbuild qw(debug copy); +use Sbuild::Base; +use Sbuild::ResolverBase; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::ResolverBase); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + my $session = shift; + my $host = shift; + + my $self = $class->SUPER::new($conf, $session, $host); + bless($self, $class); + + return $self; +} + +sub install_deps { + my $self = shift; + my $name = shift; + my @pkgs = @_; + + my $status = 0; + my $session = $self->get('Session'); + my $dummy_pkg_name = $self->get_sbuild_dummy_pkg_name($name); + + # Call functions to setup an archive to install dummy package. + $self->log_subsubsection("Setup apt archive"); + + if (!$self->setup_apt_archive($dummy_pkg_name, @pkgs)) { + $self->log_error("Setting up apt archive failed\n"); + return 0; + } + + if (!$self->update_archive()) { + $self->log_error("Updating apt archive failed\n"); + return 0; + } + + $self->log_subsubsection("Install $name build dependencies (apt-based resolver)"); + + # Install the dummy package + my (@instd, @rmvd); + $self->log("Installing build dependencies\n"); + my @apt_args = ("-yf", \@instd, \@rmvd, 'install', $dummy_pkg_name); + + if (!$self->run_apt(@apt_args)) { + $self->log_error("Package installation failed\n"); + if (defined ($self->get('Session')->get('Session Purged')) && + $self->get('Session')->get('Session Purged') == 1) { + $self->log("Not removing build depends: cloned chroot in use\n"); + } else { + $self->set_installed(@instd); + $self->set_removed(@rmvd); + goto package_cleanup; + } + return 0; + } + $self->set_installed(@instd); + $self->set_removed(@rmvd); + $status = 1; + + package_cleanup: + if ($status == 0) { + if (defined ($session->get('Session Purged')) && + $session->get('Session Purged') == 1) { + $self->log("Not removing installed packages: cloned chroot in use\n"); + } else { + $self->uninstall_deps(); + } + } + + return $status; +} + +sub purge_extra_packages { + my $self = shift; + my $name = shift; + + my $dummy_pkg_name = $self->get_sbuild_dummy_pkg_name($name); + + my $session = $self->get('Session'); + + # we partition the packages into those we want to mark as manual (all of + # Essential:yes plus sbuild dummy packages) and those we want to mark as + # auto + # + # We don't use the '*' glob of apt-mark because then we'd have all packages + # apt knows about in the build log. + my $pipe = $session->pipe_command({ + COMMAND => [ 'dpkg-query', '--showformat', '${Essential} ${Package}\\n', '--show' ], + USER => $self->get_conf('BUILD_USER') + }); + if (!$pipe) { + $self->log_error("unable to execute dpkg-query\n"); + return 0; + } + my @essential; + my @nonessential; + while (my $line = <$pipe>) { + chomp $line; + if ($line !~ /^(yes|no) ([a-zA-Z0-9][a-zA-Z0-9+.-]*)$/) { + $self->log_error("dpkg-query output has unexpected format\n"); + return 0; + } + # we only want to keep packages that are Essential:yes and the dummy + # packages created by sbuild. Apt takes care to also keep their + # transitive dependencies. + if ($1 eq "yes" || $2 eq $dummy_pkg_name || $2 eq $self->get_sbuild_dummy_pkg_name('core')) { + push @essential, $2; + } else { + push @nonessential, $2; + } + } + close $pipe; + if (scalar @essential == 0) { + $self->log_error("no essential packages found \n"); + return 0; + } + if (scalar @nonessential == 0) { + $self->log_error("no non-essential packages found \n"); + return 0; + } + + if (!$session->run_command({ COMMAND => [ 'apt-mark', 'auto', @nonessential ], USER => 'root' })) { + $self->log_error("unable to run apt-mark\n"); + return 0; + } + + # We must mark all Essential:yes packages as manual because later on we + # must run apt with --allow-remove-essential so that apt agrees to remove + # itself and at that point we don't want to remove the Essential:yes + # packages. + if (!$session->run_command({ COMMAND => [ 'apt-mark', 'manual', @essential ], USER => 'root' })) { + $self->log_error("unable to run apt-mark\n"); + return 0; + } + # apt currently suffers from bug #837066. It will never autoremove + # priority:required packages, thus we use a temporary (famous last words) + # hack here and feed apt a modified /var/lib/dpkg/status file with all + # packages marked as Priority:extra. This is a hack because + # /var/lib/dpkg/status should not be read by others than dpkg (we for + # example do not take into account the journal that way). + my $read_fh = $session->pipe_command({ + COMMAND => [ 'sed', 's/^Priority: .*$/Priority: extra/', '/var/lib/dpkg/status' ], + USER => $self->get_conf('BUILD_USER') + }); + if (!$read_fh) { + $session->log_error("cannot run sed\n"); + return 0; + } + my $tmpfilename = $session->mktemp({ USER => $self->get_conf('BUILD_USER') }); + if (!$tmpfilename) { + $session->log_error("cannot mktemp\n"); + return 0; + } + my $write_fh = $session->get_write_file_handle($tmpfilename); + if (!$write_fh) { + $session->log_error("cannot open $tmpfilename for writing\n"); + return 0; + } + while (read($read_fh, my $buffer, 1024)) { + print $write_fh $buffer; + } + close $read_fh; + close $write_fh; + + my (@instd, @rmvd); + # apt considers itself as Essential:yes, that's why we need + # --allow-remove-essential to remove it and that's why we must explicitly + # specify to remove it. + # + # The /dev/null prevents apt from overriding the Priorities that we set in + # our modified dpkg status file by the ones it finds in the package list + # files + $self->run_apt("-yf", \@instd, \@rmvd, 'autoremove', + 'apt', + '-o', 'Dir::State::Lists=/dev/null', + '-o', "Dir::State::Status=$tmpfilename", + '--allow-remove-essential'); + + $session->unlink($tmpfilename); +} + +1; diff --git a/lib/Sbuild/AptitudeResolver.pm b/lib/Sbuild/AptitudeResolver.pm new file mode 100644 index 0000000..213c678 --- /dev/null +++ b/lib/Sbuild/AptitudeResolver.pm @@ -0,0 +1,187 @@ +# ResolverBase.pm: build library for sbuild +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2005-2008 Roger Leigh <rleigh@debian.org> +# Copyright © 2008 Simon McVittie <smcv@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::AptitudeResolver; + +use strict; +use warnings; +use File::Temp qw(tempdir); + +use Sbuild qw(debug); +use Sbuild::Base; +use Sbuild::ResolverBase; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::ResolverBase); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + my $session = shift; + my $host = shift; + + my $self = $class->SUPER::new($conf, $session, $host); + bless($self, $class); + + return $self; +} + +sub install_deps { + my $self = shift; + my $name = shift; + my @pkgs = @_; + + + my $status = 0; + my $session = $self->get('Session'); + my $dummy_pkg_name = $self->get_sbuild_dummy_pkg_name($name); + my $dummy_pkg_name_for_install = $dummy_pkg_name; + # Debian without multiarch (squeeze and older) does not support + # architecture qualifiers for dependencies, so we only add them if the + # chroot supports multiarch + if ($self->get('Multiarch Support')) { + $dummy_pkg_name_for_install .= ':' . $self->get('Host Arch'); + } + + # Call functions to setup an archive to install dummy package. + $self->log_subsubsection("Setup apt archive"); + + if (!$self->setup_apt_archive($dummy_pkg_name, @pkgs)) { + $self->log_error("Setting up apt archive failed\n"); + return 0; + } + + if (!$self->update_archive()) { + $self->log_error("Updating apt archive failed\n"); + return 0; + } + + $self->log_subsection("Install $name build dependencies (aptitude-based resolver)"); + + #install aptitude first: + my (@aptitude_installed_packages, @aptitude_removed_packages); + if (!$self->run_apt('-y', \@aptitude_installed_packages, \@aptitude_removed_packages, 'install', 'aptitude')) { + $self->log_warning('Could not install aptitude!'); + goto cleanup; + } + $self->set_installed(@aptitude_installed_packages); + $self->set_removed(@aptitude_removed_packages); + + + my $ignore_trust_violations = + $self->get_conf('APT_ALLOW_UNAUTHENTICATED') ? 'true' : 'false'; + + my @aptitude_install_command = ( + $self->get_conf('APTITUDE'), + '-y', + '--without-recommends', + '-o', 'Dpkg::Options::=--force-confold', + '-o', "Aptitude::CmdLine::Ignore-Trust-Violations=$ignore_trust_violations", + '-o', 'Aptitude::ProblemResolver::StepScore=100', + '-o', "Aptitude::ProblemResolver::SolutionCost=safety, priority, non-default-versions", + '-o', "Aptitude::ProblemResolver::Hints::KeepDummy=reject $dummy_pkg_name :UNINST", + '-o', 'Aptitude::ProblemResolver::Keep-All-Level=55000', + '-o', 'Aptitude::ProblemResolver::Remove-Essential-Level=maximum', + 'install', + $dummy_pkg_name_for_install + ); + + $self->log(join(" ", @aptitude_install_command), "\n"); + + my $pipe = $self->pipe_aptitude_command( + { COMMAND => \@aptitude_install_command, + ENV => {'DEBIAN_FRONTEND' => 'noninteractive'}, + PIPE => 'in', + USER => 'root', + PRIORITY => 0, + DIR => '/' }); + + if (!$pipe) { + $self->log_warning('Cannot open pipe from aptitude: ' . $! . "\n"); + goto package_cleanup; + } + + my $aptitude_output = ""; + while(<$pipe>) { + $aptitude_output .= $_; + $self->log($_); + } + close($pipe); + my $aptitude_exit_code = $?; + + if ($aptitude_output =~ /^E:/m) { + $self->log('Satisfying build-deps with aptitude failed.' . "\n"); + goto package_cleanup; + } + + my ($installed_pkgs, $removed_pkgs) = ("", ""); + while ($aptitude_output =~ /The following NEW packages will be installed:\n((^[ ].*\n)*)/gmi) { + ($installed_pkgs = $1) =~ s/^[ ]*((.|\n)*)\s*$/$1/m; + $installed_pkgs =~ s/\*//g; + $installed_pkgs =~ s/\{.\}//g; + } + while ($aptitude_output =~ /The following packages will be REMOVED:\n((^[ ].*\n)*)/gmi) { + ($removed_pkgs = $1) =~ s/^[ ]*((.|\n)*)\s*$/$1/m; + $removed_pkgs =~ s/\*//g; + $removed_pkgs =~ s/\{.\}//g; #remove {u}, {a} in output... + } + + my @installed_packages = split( /\s+/, $installed_pkgs); + + $self->set_installed(keys %{$self->get('Changes')->{'installed'}}, @installed_packages); + $self->set_removed(keys %{$self->get('Changes')->{'removed'}}, split( /\s+/, $removed_pkgs)); + + if ($aptitude_exit_code != 0) { + goto package_cleanup; + } + + #Seems it all went fine. + + $status = 1; + + package_cleanup: + if ($status == 0) { + if (defined ($session->get('Session Purged')) && + $session->get('Session Purged') == 1) { + $self->log("Not removing installed packages: cloned chroot in use\n"); + } else { + $self->uninstall_deps(); + } + } + + cleanup: + return $status; +} + +sub purge_extra_packages { + my $self = shift; + my $name = shift; + + $self->log_error('Aptitude resolver doesn\'t implement purging of extra packages yet.\n'); +} + +1; diff --git a/lib/Sbuild/AspcudResolver.pm b/lib/Sbuild/AspcudResolver.pm new file mode 100644 index 0000000..b86db29 --- /dev/null +++ b/lib/Sbuild/AspcudResolver.pm @@ -0,0 +1,165 @@ +# ResolverBase.pm: build library for sbuild +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2005-2008 Roger Leigh <rleigh@debian.org> +# Copyright © 2008 Simon McVittie <smcv@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::AspcudResolver; + +use strict; +use warnings; + +use Sbuild::Base; +use Sbuild::ResolverBase; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::ResolverBase); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + my $session = shift; + my $host = shift; + + my $self = $class->SUPER::new($conf, $session, $host); + bless($self, $class); + + return $self; +} + +sub install_deps { + my $self = shift; + my $name = shift; + my @pkgs = @_; + + my $status = 0; + my $session = $self->get('Session'); + my $dummy_pkg_name = $self->get_sbuild_dummy_pkg_name($name); + + # Call functions to setup an archive to install dummy package. + $self->log_subsubsection("Setup apt archive"); + + if (!$self->setup_apt_archive($dummy_pkg_name, @pkgs)) { + $self->log_error("Setting up apt archive failed\n"); + return 0; + } + + if (!$self->update_archive()) { + $self->log_error("Updating apt archive failed\n"); + return 0; + } + + $self->log_subsection("Install $name build dependencies (aspcud-based resolver)"); + #install aspcud first: + my (@aspcud_installed_packages, @aspcud_removed_packages); + if (!$self->run_apt('-y', \@aspcud_installed_packages, \@aspcud_removed_packages, 'install', 'apt-cudf', 'aspcud')) { + $self->log_warning('Could not install aspcud!'); + goto cleanup; + } + $self->set_installed(@aspcud_installed_packages); + $self->set_removed(@aspcud_removed_packages); + + # Install the dummy package + my (@instd, @rmvd); + $self->log("Installing build dependencies\n"); + my @apt_args = ("-yf", \@instd, \@rmvd); + push @apt_args, 'install', $dummy_pkg_name; + + push @apt_args, '--solver', 'aspcud', + '-o', 'APT::Solver::Strict-Pinning=false', + '-o', 'APT::Solver::aspcud::Preferences='.$self->get_conf('ASPCUD_CRITERIA'); + + if (!$self->run_apt(@apt_args)) { + $self->log("Package installation failed\n"); + if (defined ($self->get('Session')->get('Session Purged')) && + $self->get('Session')->get('Session Purged') == 1) { + $self->log("Not removing build depends: cloned chroot in use\n"); + } else { + $self->set_installed(@instd); + $self->set_removed(@rmvd); + goto package_cleanup; + } + return 0; + } + $self->set_installed(@instd); + $self->set_removed(@rmvd); + $status = 1; + + package_cleanup: + if ($status == 0) { + if (defined ($session->get('Session Purged')) && + $session->get('Session Purged') == 1) { + $self->log("Not removing installed packages: cloned chroot in use\n"); + } else { + $self->uninstall_deps(); + } + } + + cleanup: + return $status; +} + +sub purge_extra_packages { + my $self = shift; + my $name = shift; + + my $dummy_pkg_name = $self->get_sbuild_dummy_pkg_name($name); + + my $session = $self->get('Session'); + + # we retrieve the list of installed Essential:yes packages because these + # must not be removed + my $pipe = $session->pipe_command({ + COMMAND => [ 'dpkg-query', '--showformat', '${Essential} ${Package}\\n', '--show' ], + USER => $self->get_conf('BUILD_USER') + }); + if (!$pipe) { + $self->log_error("unable to execute dpkg-query\n"); + return 0; + } + my @essential; + while (my $line = <$pipe>) { + chomp $line; + if ($line !~ /^yes ([a-zA-Z0-9][a-zA-Z0-9+.-]*)$/) { + next; + } + push @essential, "$1+"; + } + close $pipe; + if (scalar @essential == 0) { + $self->log_error("no essential packages found \n"); + return 0; + } + # the /dev/null prevents acpcud from even looking at external repositories, so all it can do is remove stuff + # it is also much faster that way + my (@instd, @rmvd); + $self->run_apt("-yf", \@instd, \@rmvd, 'autoremove', + @essential, $self->get_sbuild_dummy_pkg_name('core') . '+', "$dummy_pkg_name+", + '--solver', 'aspcud', + '-o', 'APT::Solver::aspcud::Preferences=+removed', + '-o', 'Dir::State::Lists=/dev/null', + '--allow-remove-essential'); +} + +1; diff --git a/lib/Sbuild/Base.pm b/lib/Sbuild/Base.pm new file mode 100644 index 0000000..48d559d --- /dev/null +++ b/lib/Sbuild/Base.pm @@ -0,0 +1,165 @@ +# +# Base.pm: base class containing common class infrastructure +# Copyright © 2008 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::Base; + +use strict; +use warnings; + +use Sbuild qw(debug); + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + + my $self = {}; + bless($self, $class); + + $self->set('Config', $conf); + + return $self; +} + +sub get { + my $self = shift; + my $key = shift; + + return $self->{$key}; +} + +sub set { + my $self = shift; + my $key = shift; + my $value = shift; + + if (defined($value)) { + debug("Setting $key=$value\n"); + } else { + debug("Setting $key=undef\n"); + } + + return $self->{$key} = $value; +} + +sub get_conf { + my $self = shift; + my $key = shift; + + return $self->get('Config')->get($key); +} + +sub set_conf { + my $self = shift; + my $key = shift; + my $value = shift; + + return $self->get('Config')->set($key,$value); +} + +sub log { + my $self = shift; + + my $logfile = $self->get('Log Stream'); + if (defined($logfile)) { + print $logfile @_; + } else { + debug("E: Attempt to log to nonexistent log stream\n") + if (!defined($self->get('Log Stream Error')) || + !$self->get('Log Stream Error')); + print STDERR @_; + $self->set('Log Stream Error', 1) + } +} + +sub log_info { + my $self = shift; + + $self->log("I: ", @_); +} + +sub log_warning { + my $self = shift; + + $self->log("W: ", @_); +} + +sub log_error { + my $self = shift; + + $self->log("E: ", @_); +} + +sub log_section { + my $self = shift; + my $section = shift; + + $self->log("\n"); + if (length($section) <= 76 ) { + $self->log('+', '=' x 78, '+', "\n"); + $self->log('|', " $section ", ' ' x (76 - length($section)), '|', "\n"); + $self->log('+', '=' x 78, '+', "\n\n"); + } else { + $self->log('+', '=' x (length($section) + 2), '+', "\n"); + $self->log('|', " $section ", '|', "\n"); + $self->log('+', '=' x (length($section) + 2), '+', "\n\n"); + } +} + +sub log_subsection { + my $self = shift; + my $section = shift; + + $self->log("\n"); + if (length($section) <= 76 ) { + $self->log('+', '-' x 78, '+', "\n"); + $self->log('|', " $section ", ' ' x (76 - length($section)), '|', "\n"); + $self->log('+', '-' x 78, '+', "\n\n"); + } else { + $self->log('+', '-' x (length($section) + 2), '+', "\n"); + $self->log('|', " $section ", '|', "\n"); + $self->log('+', '-' x (length($section) + 2), '+', "\n\n"); + } +} + +sub log_subsubsection { + my $self = shift; + my $section = shift; + + $self->log("\n"); + $self->log("$section\n"); + $self->log('-' x (length($section)), "\n\n"); +} + +sub log_sep { + my $self = shift; + + $self->log('-' x 80, "\n"); +} + +1; diff --git a/lib/Sbuild/Build.pm b/lib/Sbuild/Build.pm new file mode 100644 index 0000000..cca1c89 --- /dev/null +++ b/lib/Sbuild/Build.pm @@ -0,0 +1,3686 @@ +# +# Build.pm: build library for sbuild +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2005-2010 Roger Leigh <rleigh@debian.org> +# Copyright © 2008 Simon McVittie <smcv@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::Build; + +use strict; +use warnings; + +use English; +use POSIX; +use Errno qw(:POSIX); +use Fcntl; +use File::Temp qw(mkdtemp); +use File::Basename qw(basename dirname); +use File::Path qw(make_path); +use FileHandle; +use File::Copy qw(); # copy is already exported from Sbuild, so don't export + # anything. +use Dpkg::Arch; +use Dpkg::Control; +use Dpkg::Index; +use Dpkg::Version; +use Dpkg::Deps qw(deps_concat deps_parse); +use Dpkg::Changelog::Debian; +use Scalar::Util 'refaddr'; + +use MIME::Lite; +use Term::ANSIColor; + +use Sbuild qw($devnull binNMU_version copy isin debug send_mail + dsc_files dsc_pkgver strftime_c); +use Sbuild::Base; +use Sbuild::ChrootInfoSchroot; +use Sbuild::ChrootInfoUnshare; +use Sbuild::ChrootInfoSudo; +use Sbuild::ChrootInfoAutopkgtest; +use Sbuild::ChrootRoot; +use Sbuild::Sysconfig qw($version $release_date); +use Sbuild::Sysconfig; +use Sbuild::Resolver qw(get_resolver); +use Sbuild::Exception; + +use version; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::Base); + + @EXPORT = qw(); +} + +our $saved_stdout = undef; +our $saved_stderr = undef; + +sub new { + my $class = shift; + my $dsc = shift; + my $conf = shift; + + my $self = $class->SUPER::new($conf); + bless($self, $class); + + $self->set('ABORT', undef); + $self->set('Job', $dsc); + $self->set('Build Dir', ''); + $self->set('Max Lock Trys', 120); + $self->set('Lock Interval', 5); + $self->set('Pkg Status', 'pending'); + $self->set('Pkg Status Trigger', undef); + $self->set('Pkg Start Time', 0); + $self->set('Pkg End Time', 0); + $self->set('Pkg Fail Stage', 'init'); + $self->set('Build Start Time', 0); + $self->set('Build End Time', 0); + $self->set('Install Start Time', 0); + $self->set('Install End Time', 0); + $self->set('This Time', 0); + $self->set('This Space', 0); + $self->set('Sub Task', 'initialisation'); + $self->set('Host', Sbuild::ChrootRoot->new($self->get('Config'))); + # Host execution defaults + my $host_defaults = $self->get('Host')->get('Defaults'); + $host_defaults->{'USER'} = $self->get_conf('USERNAME'); + $host_defaults->{'DIR'} = $self->get_conf('HOME'); + $host_defaults->{'STREAMIN'} = $devnull; + $host_defaults->{'ENV'}->{'LC_ALL'} = 'C.UTF-8'; + $host_defaults->{'ENV'}->{'SHELL'} = '/bin/sh'; + $host_defaults->{'ENV_FILTER'} = $self->get_conf('ENVIRONMENT_FILTER'); + # Note, this should never fail. But, we should handle failure anyway. + $self->get('Host')->begin_session(); + + $self->set('Session', undef); + $self->set('Dependency Resolver', undef); + $self->set('Log File', undef); + $self->set('Log Stream', undef); + $self->set('Summary Stats', {}); + $self->set('dpkg-buildpackage pid', undef); + $self->set('Dpkg Version', undef); + + # DSC, package and version information: + $self->set_dsc($dsc); + + # If the job name contains an underscore then it is either the filename of + # a dsc or a pkgname_version string. In both cases we can already extract + # the version number. Otherwise it is a bare source package name and the + # version will initially be unknown. + if ($dsc =~ m/_/) { + $self->set_version($dsc); + } else { + $self->set('Package', $dsc); + } + + return $self; +} + +sub request_abort { + my $self = shift; + my $reason = shift; + + $self->log_error("ABORT: $reason (requesting cleanup and shutdown)\n"); + $self->set('ABORT', $reason); + + # Send signal to dpkg-buildpackage immediately if it's running. + if (defined $self->get('dpkg-buildpackage pid')) { + # Handling ABORT in the loop reading from the stdout/stderr output of + # dpkg-buildpackage is suboptimal because then the ABORT signal would + # only be handled once the build process writes to stdout or stderr + # which might not be immediately. + my $pid = $self->get('dpkg-buildpackage pid'); + # Sending the pid negated to send to the whole process group. + kill "TERM", -$pid; + } +} + +sub check_abort { + my $self = shift; + + if ($self->get('ABORT')) { + Sbuild::Exception::Build->throw(error => "Aborting build: " . + $self->get('ABORT'), + failstage => "abort"); + } +} + +sub set_dsc { + my $self = shift; + my $dsc = shift; + + debug("Setting DSC: $dsc\n"); + + $self->set('DSC', $dsc); + $self->set('Source Dir', dirname($dsc)); + $self->set('DSC Base', basename($dsc)); + + debug("DSC = " . $self->get('DSC') . "\n"); + debug("Source Dir = " . $self->get('Source Dir') . "\n"); + debug("DSC Base = " . $self->get('DSC Base') . "\n"); +} + +sub set_version { + my $self = shift; + my $pkgv = shift; + + debug("Setting package version: $pkgv\n"); + + my ($pkg, $version); + if (-f $pkgv && -r $pkgv) { + ($pkg, $version) = dsc_pkgver($pkgv); + } else { + ($pkg, $version) = split /_/, $pkgv; + } + my $pver = Dpkg::Version->new($version, check => 1); + return if (!defined($pkg) || !defined($version) || !defined($pver)); + my ($o_version); + $o_version = $pver->version(); + + # Original version (no binNMU or other addition) + my $oversion = $version; + # Original version with stripped epoch + my $osversion = $o_version; + $osversion .= '-' . $pver->revision() unless $pver->{'no_revision'}; + + # Add binNMU to version if needed. + if ($self->get_conf('BIN_NMU') || $self->get_conf('APPEND_TO_VERSION') + || defined $self->get_conf('BIN_NMU_CHANGELOG')) { + if (defined $self->get_conf('BIN_NMU_CHANGELOG')) { + # extract the binary version from the custom changelog entry + open(CLOGFH, '<', \$self->get_conf('BIN_NMU_CHANGELOG')); + my $changes = Dpkg::Changelog::Debian->new(); + $changes->parse(*CLOGFH, "descr"); + my @data = $changes->get_range({count => 1}); + $version = $data[0]->get_version(); + close(CLOGFH); + } else { + # compute the binary version from the original version and the + # requested binNMU and append-to-version parameters + $version = binNMU_version($version, + $self->get_conf('BIN_NMU_VERSION'), + $self->get_conf('APPEND_TO_VERSION')); + } + } + + my $bver = Dpkg::Version->new($version, check => 1); + return if (!defined($bver)); + my ($b_epoch, $b_version, $b_revision); + $b_epoch = $bver->epoch(); + $b_epoch = "" if $bver->{'no_epoch'}; + $b_version = $bver->version(); + $b_revision = $bver->revision(); + $b_revision = "" if $bver->{'no_revision'}; + + # Version with binNMU or other additions and stripped epoch + my $sversion = $b_version; + $sversion .= '-' . $b_revision if $b_revision ne ''; + + $self->set('Package', $pkg); + $self->set('Version', $version); + $self->set('Package_Version', "${pkg}_$version"); + $self->set('Package_OVersion', "${pkg}_$oversion"); + $self->set('Package_OSVersion', "${pkg}_$osversion"); + $self->set('Package_SVersion', "${pkg}_$sversion"); + $self->set('OVersion', $oversion); + $self->set('OSVersion', $osversion); + $self->set('SVersion', $sversion); + $self->set('VersionEpoch', $b_epoch); + $self->set('VersionUpstream', $b_version); + $self->set('VersionDebian', $b_revision); + $self->set('DSC File', "${pkg}_${osversion}.dsc"); + if (length $self->get_conf('DSC_DIR')) { + $self->set('DSC Dir', $self->get_conf('DSC_DIR')); + } else { + $self->set('DSC Dir', "${pkg}-${b_version}"); + } + + debug("Package = " . $self->get('Package') . "\n"); + debug("Version = " . $self->get('Version') . "\n"); + debug("Package_Version = " . $self->get('Package_Version') . "\n"); + debug("Package_OVersion = " . $self->get('Package_OVersion') . "\n"); + debug("Package_OSVersion = " . $self->get('Package_OSVersion') . "\n"); + debug("Package_SVersion = " . $self->get('Package_SVersion') . "\n"); + debug("OVersion = " . $self->get('OVersion') . "\n"); + debug("OSVersion = " . $self->get('OSVersion') . "\n"); + debug("SVersion = " . $self->get('SVersion') . "\n"); + debug("VersionEpoch = " . $self->get('VersionEpoch') . "\n"); + debug("VersionUpstream = " . $self->get('VersionUpstream') . "\n"); + debug("VersionDebian = " . $self->get('VersionDebian') . "\n"); + debug("DSC File = " . $self->get('DSC File') . "\n"); + debug("DSC Dir = " . $self->get('DSC Dir') . "\n"); +} + +sub set_status { + my $self = shift; + my $status = shift; + + $self->set('Pkg Status', $status); + if (defined($self->get('Pkg Status Trigger'))) { + $self->get('Pkg Status Trigger')->($self, $status); + } +} + +sub get_status { + my $self = shift; + + return $self->get('Pkg Status'); +} + +# This function is the main entry point into the package build. It +# provides a top-level exception handler and does the initial setup +# including initiating logging and creating host chroot. The nested +# run_ functions it calls are separate in order to permit running +# cleanup tasks in a strict order. +sub run { + my $self = shift; + + eval { + $self->check_abort(); + + $self->set_status('building'); + + $self->set('Pkg Start Time', time); + $self->set('Pkg End Time', $self->get('Pkg Start Time')); + + # Acquire the architectures we're building for and on. + $self->set('Host Arch', $self->get_conf('HOST_ARCH')); + $self->set('Build Arch', $self->get_conf('BUILD_ARCH')); + $self->set('Build Profiles', $self->get_conf('BUILD_PROFILES')); + + # Acquire the build type in the nomenclature used by the --build + # argument of dpkg-buildpackage + my $buildtype; + if ($self->get_conf('BUILD_SOURCE')) { + if ($self->get_conf('BUILD_ARCH_ANY')) { + if ($self->get_conf('BUILD_ARCH_ALL')) { + $buildtype = "full"; + } else { + $buildtype = "source,any"; + } + } else { + if ($self->get_conf('BUILD_ARCH_ALL')) { + $buildtype = "source,all"; + } else { + $buildtype = "source"; + } + } + } else { + if ($self->get_conf('BUILD_ARCH_ANY')) { + if ($self->get_conf('BUILD_ARCH_ALL')) { + $buildtype = "binary"; + } else { + $buildtype = "any"; + } + } else { + if ($self->get_conf('BUILD_ARCH_ALL')) { + $buildtype = "all"; + } else { + Sbuild::Exception::Build->throw(error => "Neither architecture specific nor architecture independent or source package specified to be built.", + failstage => "init"); + } + } + } + $self->set('Build Type', $buildtype); + + my $dist = $self->get_conf('DISTRIBUTION'); + if (!defined($dist) || !$dist) { + Sbuild::Exception::Build->throw(error => "No distribution defined", + failstage => "init"); + } + + # TODO: Get package name from build object + if (!$self->open_build_log()) { + Sbuild::Exception::Build->throw(error => "Failed to open build log", + failstage => "init"); + } + + # Set a chroot to run commands in host + my $host = $self->get('Host'); + + # Host execution defaults (set streams) + my $host_defaults = $host->get('Defaults'); + $host_defaults->{'STREAMIN'} = $devnull; + $host_defaults->{'STREAMOUT'} = $self->get('Log Stream'); + $host_defaults->{'STREAMERR'} = $self->get('Log Stream'); + + $self->check_abort(); + $self->run_chroot(); + }; + + debug("Error run(): $@") if $@; + + my $e; + if ($e = Exception::Class->caught('Sbuild::Exception::Build')) { + if ($e->status) { + $self->set_status($e->status); + } else { + $self->set_status("failed"); + } + $self->set('Pkg Fail Stage', $e->failstage); + $e->rethrow(); + } +} + +# Pack up source if needed and then run the main chroot session. +# Close log during return/failure. +sub run_chroot { + my $self = shift; + + eval { + $self->check_abort(); + $self->run_chroot_session(); + }; + + debug("Error run_chroot(): $@") if $@; + + # Log exception info and set status and fail stage prior to + # closing build log. + my $e; + if ($e = Exception::Class->caught('Sbuild::Exception::Build')) { + $self->log_error("$e\n"); + $self->log_info($e->info."\n") + if ($e->info); + if ($e->status) { + $self->set_status($e->status); + } else { + $self->set_status("failed"); + } + $self->set('Pkg Fail Stage', $e->failstage); + } + + $self->close_build_log(); + + if ($e) { + $e->rethrow(); + } +} + +# Create main chroot session and package resolver. Creates a lock in +# the chroot to prevent concurrent chroot usage (only important for +# non-snapshot chroots). Ends chroot session on return/failure. +sub run_chroot_session { + my $self=shift; + + eval { + $self->check_abort(); + my $chroot_info; + if ($self->get_conf('CHROOT_MODE') eq 'schroot') { + $chroot_info = Sbuild::ChrootInfoSchroot->new($self->get('Config')); + } elsif ($self->get_conf('CHROOT_MODE') eq 'autopkgtest') { + $chroot_info = Sbuild::ChrootInfoAutopkgtest->new($self->get('Config')); + } elsif ($self->get_conf('CHROOT_MODE') eq 'unshare') { + $chroot_info = Sbuild::ChrootInfoUnshare->new($self->get('Config')); + } else { + $chroot_info = Sbuild::ChrootInfoSudo->new($self->get('Config')); + } + + my $host = $self->get('Host'); + + my $session = $chroot_info->create('chroot', + $self->get_conf('DISTRIBUTION'), + $self->get_conf('CHROOT'), + $self->get_conf('BUILD_ARCH')); + if (!defined $session) { + Sbuild::Exception::Build->throw(error => "Error creating chroot", + failstage => "create-session"); + } + + $self->check_abort(); + if (!$session->begin_session()) { + Sbuild::Exception::Build->throw(error => "Error creating chroot session: skipping " . + $self->get('Package'), + failstage => "create-session"); + } + + $self->set('Session', $session); + + $self->check_abort(); + my $chroot_arch = $self->chroot_arch(); + if ($self->get_conf('BUILD_ARCH') ne $chroot_arch) { + Sbuild::Exception::Build->throw( + error => "Requested build architecture (" . + $self->get_conf('BUILD_ARCH') . + ") and chroot architecture (" . $chroot_arch . + ") do not match. Skipping build.", + info => "Please specify the correct architecture with --build, or use a chroot of the correct architecture", + failstage => "create-session"); + } + + if (length $self->get_conf('BUILD_PATH')) { + my $build_path = $self->get_conf('BUILD_PATH'); + $self->set('Build Dir', $build_path); + if (!($session->test_directory($build_path))) { + if (!$session->mkdir($build_path, { PARENTS => 1})) { + Sbuild::Exception::Build->throw( + error => "Buildpath: " . $build_path . " cannot be created", + failstage => "create-session"); + } + } else { + my $isempty = <<END; +if (opendir my \$dfh, "$build_path") { + while (defined(my \$file=readdir \$dfh)) { + next if \$file eq "." or \$file eq ".."; + closedir \$dfh; + exit 1 + } + closedir \$dfh; + exit 0 +} +exit 2 +END + $session->run_command({ + COMMAND => ['perl', '-e', $isempty], + USER => 'root', + DIR => '/' + }); + if ($? == 1) { + Sbuild::Exception::Build->throw( + error => "Buildpath: " . $build_path . " is not empty", + failstage => "create-session"); + } + elsif ($? == 2) { + Sbuild::Exception::Build->throw( + error => "Buildpath: " . $build_path . " cannot be read. Insufficient permissions?", + failstage => "create-session"); + } + } + } else { + # we run mktemp within the chroot instead of using File::Temp::tempdir because the user + # running sbuild might not have permissions creating a directory in /build. This happens + # when the chroot was extracted in a different user namespace than the outer user + $self->check_abort(); + my $tmpdir = $session->mktemp({ + TEMPLATE => "/build/" . $self->get('Package') . '-XXXXXX', + DIRECTORY => 1}); + if (!$tmpdir) { + $self->log_error("unable to mktemp\n"); + Sbuild::Exception::Build->throw(error => "unable to mktemp", + failstage => "create-build-dir"); + } + $self->check_abort(); + $self->set('Build Dir', $tmpdir); + } + + # Copy in external solvers if we are cross-building + if ($self->get('Host Arch') ne $self->get('Build Arch')) { + if (!$session->test_directory("/usr/lib/apt/solvers")) { + if (!$session->mkdir("/usr/lib/apt/solvers", { PARENTS => 1})) { + Sbuild::Exception::Build->throw( + error => "/usr/lib/apt/solvers cannot be created", + failstage => "create-session"); + } + } + foreach my $solver ('apt', 'sbuild-cross-resolver') { + if ($session->test_regular_file_readable("/usr/lib/apt/solvers/$solver")) { + next; + } + if (! -e "/usr/lib/apt/solvers/$solver") { + Sbuild::Exception::Build->throw( + error => "/usr/lib/apt/solvers/$solver is missing", + failstage => "create-session"); + } + if (! $session->copy_to_chroot("/usr/lib/apt/solvers/$solver", "/usr/lib/apt/solvers/$solver")) { + Sbuild::Exception::Build->throw( + error => "/usr/lib/apt/solvers/$solver cannot be copied", + failstage => "create-session"); + } + if (! $session->chmod("/usr/lib/apt/solvers/$solver", "0755")) { + Sbuild::Exception::Build->throw( + error => "/usr/lib/apt/solvers/$solver cannot chmod", + failstage => "create-session"); + } + } + } + + # Run pre build external commands + $self->check_abort(); + if(!$self->run_external_commands("pre-build-commands")) { + Sbuild::Exception::Build->throw(error => "Failed to execute pre-build-commands", + failstage => "run-pre-build-commands"); + } + + # Log colouring + $self->build_log_colour('red', '^E: '); + $self->build_log_colour('yellow', '^W: '); + $self->build_log_colour('green', '^I: '); + $self->build_log_colour('red', '^Status:'); + $self->build_log_colour('green', '^Status: successful$'); + $self->build_log_colour('yellow', '^Keeping session: '); + $self->build_log_colour('red', '^Lintian:'); + $self->build_log_colour('yellow', '^Lintian: warn$'); + $self->build_log_colour('green', '^Lintian: pass$'); + $self->build_log_colour('green', '^Lintian: info$'); + $self->build_log_colour('red', '^Piuparts:'); + $self->build_log_colour('green', '^Piuparts: pass$'); + $self->build_log_colour('red', '^Autopkgtest:'); + $self->build_log_colour('yellow', '^Autopkgtest: no tests$'); + $self->build_log_colour('green', '^Autopkgtest: pass$'); + + # Log filtering + my $filter; + $filter = $session->get('Location'); + $filter =~ s;^/;;; + $self->build_log_filter($filter , 'CHROOT'); + + # Need tempdir to be writable and readable by sbuild group. + $self->check_abort(); + if (!$session->chown($self->get('Build Dir'), $self->get_conf('BUILD_USER'), 'sbuild')) { + Sbuild::Exception::Build->throw(error => "Failed to set sbuild group ownership on chroot build dir", + failstage => "create-build-dir"); + } + $self->check_abort(); + if (!$session->chmod($self->get('Build Dir'), "ug=rwx,o=,a-s")) { + Sbuild::Exception::Build->throw(error => "Failed to set sbuild group ownership on chroot build dir", + failstage => "create-build-dir"); + } + + $self->check_abort(); + # Needed so chroot commands log to build log + $session->set('Log Stream', $self->get('Log Stream')); + $host->set('Log Stream', $self->get('Log Stream')); + + # Chroot execution defaults + my $chroot_defaults = $session->get('Defaults'); + $chroot_defaults->{'DIR'} = $self->get('Build Dir'); + $chroot_defaults->{'STREAMIN'} = $devnull; + $chroot_defaults->{'STREAMOUT'} = $self->get('Log Stream'); + $chroot_defaults->{'STREAMERR'} = $self->get('Log Stream'); + $chroot_defaults->{'ENV'}->{'LC_ALL'} = 'C.UTF-8'; + $chroot_defaults->{'ENV'}->{'SHELL'} = '/bin/sh'; + $chroot_defaults->{'ENV'}->{'HOME'} = '/sbuild-nonexistent'; + $chroot_defaults->{'ENV_FILTER'} = $self->get_conf('ENVIRONMENT_FILTER'); + + my $resolver = get_resolver($self->get('Config'), $session, $host); + $resolver->set('Log Stream', $self->get('Log Stream')); + $resolver->set('Arch', $self->get_conf('ARCH')); + $resolver->set('Host Arch', $self->get_conf('HOST_ARCH')); + $resolver->set('Build Arch', $self->get_conf('BUILD_ARCH')); + $resolver->set('Build Profiles', $self->get_conf('BUILD_PROFILES')); + $resolver->set('Build Dir', $self->get('Build Dir')); + $self->set('Dependency Resolver', $resolver); + + # Lock chroot so it won't be tampered with during the build. + $self->check_abort(); + my $jobname; + # the version might not yet be known if the user only passed a package + # name without a version to sbuild + if ($self->get('Package_SVersion')) { + $jobname = $self->get('Package_SVersion'); + } else { + $jobname = $self->get('Package'); + } + if (!$session->lock_chroot($jobname, $$, $self->get_conf('USERNAME'))) { + Sbuild::Exception::Build->throw(error => "Error locking chroot session: skipping " . + $self->get('Package'), + failstage => "lock-session"); + } + + $self->check_abort(); + $self->run_chroot_session_locked(); + }; + + debug("Error run_chroot_session(): $@") if $@; + + if ($self->get('Pkg Status') ne "successful") { + if(!$self->run_external_commands("post-build-failed-commands")) { + Sbuild::Exception::Build->throw(error => "Failed to execute post-build-commands", + failstage => "run-post-build-failed-commands"); + } + } + + # End chroot session + my $session = $self->get('Session'); + if (defined $session) { + my $end_session = + ($self->get_conf('PURGE_SESSION') eq 'always' || + ($self->get_conf('PURGE_SESSION') eq 'successful' && + $self->get_status() eq 'successful')) ? 1 : 0; + if ($end_session) { + $session->end_session(); + } else { + $self->log("Keeping session: " . $session->get('Session ID') . "\n"); + } + $session = undef; + } + $self->set('Session', $session); + + my $e; + if ($e = Exception::Class->caught('Sbuild::Exception::Build')) { + $e->rethrow(); + } +} + +# Run tasks in a *locked* chroot. Update and upgrade packages. +# Unlocks chroot on return/failure. +sub run_chroot_session_locked { + my $self = shift; + + eval { + my $session = $self->get('Session'); + my $resolver = $self->get('Dependency Resolver'); + + # Run specified chroot setup commands + $self->check_abort(); + if(!$self->run_external_commands("chroot-setup-commands")) { + Sbuild::Exception::Build->throw(error => "Failed to execute chroot-setup-commands", + failstage => "run-chroot-setup-commands"); + } + + $self->check_abort(); + + + $self->check_abort(); + if (!$resolver->setup()) { + Sbuild::Exception::Build->throw(error => "resolver setup failed", + failstage => "resolver setup"); + } + + my $filter; + $filter = $resolver->get('Dummy package path'); + $filter =~ s;^/;;; + $self->build_log_filter($filter , 'RESOLVERDIR'); + + $self->check_abort(); + $self->run_chroot_update(); + + $self->check_abort(); + $self->run_fetch_install_packages(); + }; + + debug("Error run_chroot_session_locked(): $@") if $@; + + my $session = $self->get('Session'); + my $resolver = $self->get('Dependency Resolver'); + + $resolver->cleanup(); + # Unlock chroot now it's cleaned up and ready for other users. + $session->unlock_chroot(); + + my $e; + if ($e = Exception::Class->caught('Sbuild::Exception::Build')) { + $e->rethrow(); + } +} + +sub run_chroot_update { + my $self = shift; + my $resolver = $self->get('Dependency Resolver'); + + eval { + if ($self->get_conf('APT_CLEAN') || $self->get_conf('APT_UPDATE') || + $self->get_conf('APT_DISTUPGRADE') || $self->get_conf('APT_UPGRADE')) { + $self->log_subsection('Update chroot'); + } + + # Clean APT cache. + $self->check_abort(); + if ($self->get_conf('APT_CLEAN')) { + if ($resolver->clean()) { + # Since apt-clean was requested specifically, fail on + # error when not in buildd mode. + $self->log_error("apt-get clean failed\n"); + if ($self->get_conf('SBUILD_MODE') ne 'buildd') { + Sbuild::Exception::Build->throw(error => "apt-get clean failed", + failstage => "apt-get-clean"); + } + } + } + + # Update APT cache. + $self->check_abort(); + if ($self->get_conf('APT_UPDATE')) { + if ($resolver->update()) { + # Since apt-update was requested specifically, fail on + # error when not in buildd mode. + if ($self->get_conf('SBUILD_MODE') ne 'buildd') { + Sbuild::Exception::Build->throw(error => "apt-get update failed", + failstage => "apt-get-update"); + } + } + } else { + # If it was requested not to do an apt update, the build and host + # architecture must already be part of the chroot. If they are not + # and thus added during the sbuild run, issue a warning because + # then the package build dependencies will likely fail to be + # installable. + # + # The logic which checks which architectures are needed is in + # ResolverBase.pm, so we just check whether any architectures + # where added with 'dpkg --add-architecture' because if any were + # added an update is most likely needed. + if (keys %{$resolver->get('Added Foreign Arches')}) { + $self->log_warning("Additional architectures were added but apt update was disabled. Build dependencies might not be satisfiable.\n"); + } + } + + # Upgrade using APT. + $self->check_abort(); + if ($self->get_conf('APT_DISTUPGRADE')) { + if ($resolver->distupgrade()) { + # Since apt-distupgrade was requested specifically, fail on + # error when not in buildd mode. + if ($self->get_conf('SBUILD_MODE') ne 'buildd') { + Sbuild::Exception::Build->throw(error => "apt-get dist-upgrade failed", + failstage => "apt-get-dist-upgrade"); + } + } + } elsif ($self->get_conf('APT_UPGRADE')) { + if ($resolver->upgrade()) { + # Since apt-upgrade was requested specifically, fail on + # error when not in buildd mode. + if ($self->get_conf('SBUILD_MODE') ne 'buildd') { + Sbuild::Exception::Build->throw(error => "apt-get upgrade failed", + failstage => "apt-get-upgrade"); + } + } + } + }; + + debug("Error run_chroot_update(): $@") if $@; + + my $e = Exception::Class->caught('Sbuild::Exception::Build'); + if ($e) { + $self->run_external_commands("chroot-update-failed-commands"); + $e->rethrow(); + } +} + +# Fetch sources, run setup, fetch and install core and package build +# deps, then run build. Cleans up build directory and uninstalls +# build depends on return/failure. +sub run_fetch_install_packages { + my $self = shift; + + $self->check_abort(); + eval { + my $session = $self->get('Session'); + my $resolver = $self->get('Dependency Resolver'); + + $self->check_abort(); + if (!$self->fetch_source_files()) { + Sbuild::Exception::Build->throw(error => "Failed to fetch source files", + failstage => "fetch-src"); + } + + # Display message about chroot setup script option use being deprecated + if ($self->get_conf('CHROOT_SETUP_SCRIPT')) { + my $msg = "setup-hook option is deprecated. It has been superseded by "; + $msg .= "the chroot-setup-commands feature. setup-hook script will be "; + $msg .= "run via chroot-setup-commands.\n"; + $self->log_warning($msg); + } + + $self->check_abort(); + $self->set('Install Start Time', time); + $self->set('Install End Time', $self->get('Install Start Time')); + my @coredeps = @{$self->get_conf('CORE_DEPENDS')}; + if ($self->get('Host Arch') ne $self->get('Build Arch')) { + my $crosscoredeps = $self->get_conf('CROSSBUILD_CORE_DEPENDS'); + if (defined($crosscoredeps->{$self->get('Host Arch')})) { + push(@coredeps, @{$crosscoredeps->{$self->get('Host Arch')}}); + } else { + push(@coredeps, 'crossbuild-essential-' . $self->get('Host Arch') . ':native'); + # Also add the following to work around bug #815172 + push(@coredeps, 'libc-dev:' . $self->get('Host Arch'), + 'libstdc++-dev:' . $self->get('Host Arch')); + } + } + + my @snapshot = (); + @snapshot = ("gcc-snapshot") if ($self->get_conf('GCC_SNAPSHOT')); + + $resolver->add_dependencies('MAIN', + join(", ", $self->get('Build Depends') // (), + @{$self->get_conf('MANUAL_DEPENDS')}, @snapshot, @coredeps), + join(", ", $self->get('Build Depends Arch') // (), + @{$self->get_conf('MANUAL_DEPENDS_ARCH')}), + join(", ", $self->get('Build Depends Indep') // (), + @{$self->get_conf('MANUAL_DEPENDS_INDEP')}), + join(", ", $self->get('Build Conflicts') // (), + @{$self->get_conf('MANUAL_CONFLICTS')}), + join(", ", $self->get('Build Conflicts Arch') // (), + @{$self->get_conf('MANUAL_CONFLICTS_ARCH')}), + join(", ", $self->get('Build Conflicts Indep') // (), + @{$self->get_conf('MANUAL_CONFLICTS_INDEP')})); + + $self->log_subsection("Install package build dependencies"); + + $self->check_abort(); + if (!$resolver->install_deps('main', 'MAIN')) { + Sbuild::Exception::Build->throw(error => "Package build dependencies not satisfied; skipping", + failstage => "install-deps"); + } + $self->check_abort(); + if ($self->get_conf('PURGE_EXTRA_PACKAGES')) { + if (!$resolver->purge_extra_packages($self->get('Package'))) { + Sbuild::Exception::Build->throw(error => "Chroot could not be cleaned of extra packages", + failstage => "install-deps"); + } + } + $self->set('Install End Time', time); + + # the architecture check has to be done *after* build-essential is + # installed because as part of the architecture check a perl script is + # run inside the chroot which requires the Dpkg::Arch module which is + # in libdpkg-perl which might not exist in the chroot but will get + # installed by the build-essential package + if(!$self->check_architectures()) { + Sbuild::Exception::Build->throw(error => "Architecture check failed", + failstage => "check-architecture"); + } + + $self->check_abort(); + my $dpkg_version = $resolver->dump_build_environment(); + $self->set('Dpkg Version',Dpkg::Version->new($dpkg_version)); + + $self->check_abort(); + if ($self->build()) { + $self->set_status('successful'); + } else { + $self->set('Pkg Fail Stage', "build"); + $self->set_status('failed'); + } + + # We run it here and not inside build() because otherwise, we cannot + # set the overall status to failed due to lintian errors + if ($self->get('Pkg Status') eq "successful") { + # Run lintian. + $self->check_abort(); + my $ret = $self->run_lintian(); + if (!$ret && $self->get_conf('LINTIAN_REQUIRE_SUCCESS')) { + $self->set('Pkg Fail Stage', "post-build"); + $self->set_status("failed"); + } + } + + # Run specified chroot cleanup commands + $self->check_abort(); + if (!$self->run_external_commands("chroot-cleanup-commands")) { + Sbuild::Exception::Build->throw(error => "Failed to execute chroot-cleanup-commands", + failstage => "run-chroot-cleanup-commands"); + } + + # piuparts and autopkgtest must be run while the chroot is still open + # because they might need files that are not available on the host, + # for example the .dsc which might have been downloaded + if ($self->get('Pkg Status') eq "successful") { + $self->log_subsection("Post Build"); + + # Run piuparts. + $self->check_abort(); + my $ret = $self->run_piuparts(); + if (!$ret && $self->get_conf('PIUPARTS_REQUIRE_SUCCESS')) { + $self->set('Pkg Fail Stage', "post-build"); + $self->set_status("failed"); + } + + # Run autopkgtest. + $self->check_abort(); + $ret = $self->run_autopkgtest(); + if (!$ret && $self->get_conf('AUTOPKGTEST_REQUIRE_SUCCESS')) { + $self->set('Pkg Fail Stage', "post-build"); + $self->set_status("failed"); + } + + # Run post build external commands + $self->check_abort(); + if(!$self->run_external_commands("post-build-commands")) { + Sbuild::Exception::Build->throw(error => "Failed to execute post-build-commands", + failstage => "run-post-build-commands"); + } + + } + }; + + # If 'This Time' is still zero, then build() raised an exception and thus + # the end time was never set. Thus, setting it here. + # If we would set 'This Time' here unconditionally, then it would also + # possibly include the times to run piuparts and autopkgtest. + if ($self->get('This Time') == 0) { + $self->set('This Time', $self->get('Pkg End Time') - $self->get('Pkg Start Time')); + $self->set('This Time', 0) if $self->get('This Time') < 0; + } + # Same for 'This Space' which we must set here before everything gets + # cleaned up. + if ($self->get('This Space') == 0) { + # Since the build apparently failed, we pass an empty list of the + # build artifacts + $self->set('This Space', $self->check_space()); + } + + debug("Error run_fetch_install_packages(): $@") if $@; + + # I catch the exception here and trigger the hook, if needed. Normally I'd + # do this at the end of the function, but I want the hook to fire before we + # clean up the environment. I re-throw the exception at the end, as usual + my $e = Exception::Class->caught('Sbuild::Exception::Build'); + if ($e) { + if ($e->status) { + $self->set_status($e->status); + } else { + $self->set_status("failed"); + } + $self->set('Pkg Fail Stage', $e->failstage); + } + if (!$self->get('ABORT') && defined $self->get('Pkg Fail Stage')) { + if ($self->get('Pkg Fail Stage') eq 'build' ) { + if(!$self->run_external_commands("build-failed-commands")) { + Sbuild::Exception::Build->throw(error => "Failed to execute build-failed-commands", + failstage => "run-build-failed-commands"); + } + } elsif($self->get('Pkg Fail Stage') eq 'install-deps' ) { + my $could_not_explain = undef; + + if (defined $self->get_conf('BD_UNINSTALLABLE_EXPLAINER') + && $self->get_conf('BD_UNINSTALLABLE_EXPLAINER') ne '' + && $self->get_conf('BD_UNINSTALLABLE_EXPLAINER') ne 'none') { + if (!$self->explain_bd_uninstallable()) { + $could_not_explain = 1; + } + } + + if(!$self->run_external_commands("build-deps-failed-commands")) { + Sbuild::Exception::Build->throw(error => "Failed to execute build-deps-failed-commands", + failstage => "run-build-deps-failed-commands"); + } + + if( $could_not_explain ) { + Sbuild::Exception::Build->throw(error => "Failed to explain bd-uninstallable", + failstage => "explain-bd-uninstallable"); + } + } + } + + $self->log_subsection("Cleanup"); + my $session = $self->get('Session'); + my $resolver = $self->get('Dependency Resolver'); + + my $purge_build_directory = + ($self->get_conf('PURGE_BUILD_DIRECTORY') eq 'always' || + ($self->get_conf('PURGE_BUILD_DIRECTORY') eq 'successful' && + $self->get_status() eq 'successful')) ? 1 : 0; + my $purge_build_deps = + ($self->get_conf('PURGE_BUILD_DEPS') eq 'always' || + ($self->get_conf('PURGE_BUILD_DEPS') eq 'successful' && + $self->get_status() eq 'successful')) ? 1 : 0; + my $is_cloned_session = (defined ($session->get('Session Purged')) && + $session->get('Session Purged') == 1) ? 1 : 0; + + if ($purge_build_directory) { + # Purge package build directory + $self->log("Purging " . $self->get('Build Dir') . "\n"); + if (!$self->get('Session')->unlink($self->get('Build Dir'), { RECURSIVE => 1 })) { + $self->log_error("unable to remove build directory\n"); + } + } + + # Purge non-cloned session + if ($is_cloned_session) { + $self->log("Not cleaning session: cloned chroot in use\n"); + } else { + if ($purge_build_deps) { + # Removing dependencies + $resolver->uninstall_deps(); + } else { + $self->log("Not removing build depends: as requested\n"); + } + } + + + # re-throw the previously-caught exception + if ($e) { + $e->rethrow(); + } +} + +sub copy_to_chroot { + my $self = shift; + my $source = shift; + my $chrootdest = shift; + + my $session = $self->get('Session'); + + $self->check_abort(); + if(!$session->copy_to_chroot($source, $chrootdest)) { + $self->log_error("Failed to copy $source to $chrootdest\n"); + return 0; + } + + if (!$session->chown($chrootdest, $self->get_conf('BUILD_USER'), 'sbuild')) { + $self->log_error("Failed to set sbuild group ownership on $chrootdest\n"); + return 0; + } + if (!$session->chmod($chrootdest, "ug=rw,o=r,a-s")) { + $self->log_error("Failed to set 0644 permissions on $chrootdest\n"); + return 0; + } + + return 1; +} +sub fetch_source_files { + my $self = shift; + + my $build_dir = $self->get('Build Dir'); + my $host_arch = $self->get('Host Arch'); + my $resolver = $self->get('Dependency Resolver'); + + my ($dscarchs, $dscpkg, $dscver, $dsc); + + my $build_depends = ""; + my $build_depends_arch = ""; + my $build_depends_indep = ""; + my $build_conflicts = ""; + my $build_conflicts_arch = ""; + my $build_conflicts_indep = ""; + local( *F ); + + $self->log_subsection("Fetch source files"); + + $self->check_abort(); + if ($self->get('DSC Base') =~ m/\.dsc$/) { + my $dir = $self->get('Source Dir'); + + # Work with a .dsc file. + my $file = $self->get('DSC'); + $dsc = $self->get('DSC File'); + if (! -f $file || ! -r $file) { + $self->log_error("Could not find $file\n"); + return 0; + } + my @cwd_files = dsc_files($file); + + # Copy the local source files into the build directory. + $self->log_subsubsection("Local sources"); + $self->log("$file exists in $dir; copying to chroot\n"); + if (! $self->copy_to_chroot("$file", "$build_dir/$dsc")) { + $self->log_error("Could not copy $file to $build_dir/$dsc\n"); + return 0; + } + foreach (@cwd_files) { + if (! $self->copy_to_chroot("$dir/$_", "$build_dir/$_")) { + $self->log_error("Could not copy $dir/$_ to $build_dir/$_\n"); + return 0; + } + } + } else { + my $pkg = $self->get('DSC'); + my $ver; + + if ($pkg =~ m/_/) { + ($pkg, $ver) = split /_/, $pkg; + } + + # Use apt to download the source files + $self->log_subsubsection("Check APT"); + + my $indextargets; + { + my $pipe = $self->get('Session')->pipe_command( + { + COMMAND => [ 'apt-get', 'indextargets' ], + USER => $self->get_conf('BUILD_USER'), + } + ); + if ( !$pipe ) { + $self->log_error("Can't open pipe to apt-get: $!\n"); + return 0; + } + $indextargets = + Dpkg::Index->new( get_key_func => sub { return $_[0]->{URI}; } ); + + if ( !$indextargets->parse( $pipe, 'apt-get indextargets' ) ) { + $self->log_error( + "Cannot parse output of apt-get indextargets: $!\n"); + return 0; + } + close($pipe); + + if ($?) { + $self->log_error("apt-get indextargets exit status $?: $!\n"); + return 0; + } + } + my $found_sources_entry = 0; + my $num_packages_entries = 0; + my $entry_uri = undef; + my $entry_codename = undef; + my $entry_component = undef; + foreach my $key ( $indextargets->get_keys() ) { + my $cdata = $indextargets->get_by_key($key); + my $createdby = $cdata->{"Created-By"} // ""; + my $targetof = $cdata->{"Target-Of"} // ""; + my $identifier = $cdata->{"Identifier"} // ""; + if ( $createdby eq "Sources" + and $identifier eq "Sources" + and $targetof eq "deb-src" ) + { + $found_sources_entry = 1; + } + if ( $createdby eq 'Packages' + and $identifier eq 'Packages' + and $targetof eq 'deb' + and length $cdata->{"Repo-URI"} > 0 + and length $cdata->{"Codename"} > 0 + and length $cdata->{"Label"} > 0 + and length $cdata->{"Origin"} > 0 + and length $cdata->{"Suite"} > 0 + and $cdata->{"Repo-URI"} =~ /^file:\// + and $cdata->{"Codename"} eq 'invalid-sbuild-codename' + and $cdata->{'Label'} eq 'sbuild-build-depends-archive' + and $cdata->{'Origin'} eq 'sbuild-build-depends-archive' + and $cdata->{'Suite'} eq 'invalid-sbuild-suite' ) + { + # do not count the sbuild dummy repository created by any + # --extra-package options + next; + } + if ( $createdby eq 'Packages' + and $identifier eq 'Packages' + and $targetof eq 'deb' + and length $cdata->{"Repo-URI"} > 0 + and length $cdata->{"Codename"} > 0 + and length $cdata->{"Component"} > 0 ) + { + $num_packages_entries += 1; + $entry_uri = $cdata->{"Repo-URI"}; + $entry_codename = $cdata->{"Codename"}; + $entry_component = $cdata->{"Component"}; + } + } + if ( !$found_sources_entry ) { + $self->log("There are no deb-src lines in your sources.list\n"); + if ( $num_packages_entries == 0 ) { + $self->log("Cannot generate deb-src entry without deb entry\n"); + } + elsif ( $num_packages_entries > 1 ) { + $self->log( "Cannot generate deb-src entry " + . "with more than one deb entry\n" ); + } + else { + my $entry = + "deb-src $entry_uri $entry_codename $entry_component"; + $self->log( + "Automatically adding to EXTRA_REPOSITORIES: $entry\n"); + push @{ $self->get_conf('EXTRA_REPOSITORIES') }, $entry; + $resolver->add_extra_repositories(); + $self->run_chroot_update(); + } + } + + $self->log("Checking available source versions...\n"); + + # We would like to call apt-cache with --only-source so that the + # result only contains source packages with the given name but this + # feature was only introduced in apt 1.1~exp10 so it is only available + # in Debian Stretch and later + my $pipe = $self->get('Dependency Resolver')->pipe_apt_command( + { COMMAND => [$self->get_conf('APT_CACHE'), + '-q', 'showsrc', $pkg], + USER => $self->get_conf('BUILD_USER'), + PRIORITY => 0, + DIR => '/'}); + if (!$pipe) { + $self->log_error("Can't open pipe to ".$self->get_conf('APT_CACHE').": $!\n"); + return 0; + } + + my $key_func = sub { + return $_[0]->{Package} . '_' . $_[0]->{Version}; + }; + + my $index = Dpkg::Index->new(get_key_func=>$key_func); + + if (!$index->parse($pipe, 'apt-cache showsrc')) { + $self->log_error("Cannot parse output of apt-cache showsrc: $!\n"); + return 0; + } + + close($pipe); + + if ($?) { + $self->log_error($self->get_conf('APT_CACHE') . " exit status $?: $!\n"); + return 0; + } + + my $highestversion; + my $highestdsc; + + foreach my $key ($index->get_keys()) { + my $cdata = $index->get_by_key($key); + my $pkgname = $cdata->{"Package"}; + if (not defined($pkgname)) { + $self->log_warning("apt-cache output without Package field\n"); + next; + } + # Since we cannot run apt-cache with --only-source because that + # feature was only introduced with apt 1.1~exp10, the result can + # contain source packages that we didn't ask for (but which + # contain binary packages of the name we specified). Since we only + # are interested in source packages of the given name, we skip + # everything that is a different source package. + if ($pkg ne $pkgname) { + next; + } + my $pkgversion = $cdata->{"Version"}; + if (not defined($pkgversion)) { + $self->log_warning("apt-cache output without Version field\n"); + next; + } + if (defined($ver) and $ver ne $pkgversion) { + next; + } + my $checksums = Dpkg::Checksums->new(); + $checksums->add_from_control($cdata, use_files_for_md5 => 1); + my @files = grep {/\.dsc$/} $checksums->get_files(); + if (scalar @files != 1) { + $self->log_warning("apt-cache output with more than one .dsc\n"); + next; + } + if (!defined $highestdsc) { + $highestdsc = $files[0]; + $highestversion = $pkgversion; + } else { + if (version_compare($highestversion, $pkgversion) < 0) { + $highestdsc = $files[0]; + $highestversion = $pkgversion; + } + } + } + + if (!defined $highestdsc) { + $self->log_error($self->get_conf('APT_CACHE') . + " returned no information about $pkg source\n"); + $self->log_error("Are there any deb-src lines in your /etc/apt/sources.list?\n"); + return 0; + } + + $self->set_dsc($highestdsc); + $dsc = $highestdsc; + + $self->log_subsubsection("Download source files with APT"); + + my $pipe2 = $self->get('Dependency Resolver')->pipe_apt_command( + { COMMAND => [$self->get_conf('APT_GET'), '--only-source', '-q', '-d', 'source', "$pkg=$highestversion"], + USER => $self->get_conf('BUILD_USER'), + PRIORITY => 0}) || return 0; + + while(<$pipe2>) { + $self->log($_); + } + close($pipe2); + if ($?) { + $self->log_error($self->get_conf('APT_GET') . " for sources failed\n"); + return 0; + } + } + + my $pipe = $self->get('Session')->get_read_file_handle("$build_dir/$dsc"); + if (!$pipe) { + $self->log_error("unable to open pipe\n"); + return 0; + } + + my $pdsc = Dpkg::Control->new(type => CTRL_PKG_SRC); + $pdsc->set_options(allow_pgp => 1); + if (!$pdsc->parse($pipe, "$build_dir/$dsc")) { + $self->log_error("Error parsing $build_dir/$dsc\n"); + return 0; + } + + close($pipe); + + $build_depends = $pdsc->{'Build-Depends'}; + $build_depends_arch = $pdsc->{'Build-Depends-Arch'}; + $build_depends_indep = $pdsc->{'Build-Depends-Indep'}; + $build_conflicts = $pdsc->{'Build-Conflicts'}; + $build_conflicts_arch = $pdsc->{'Build-Conflicts-Arch'}; + $build_conflicts_indep = $pdsc->{'Build-Conflicts-Indep'}; + $dscarchs = $pdsc->{'Architecture'}; + $dscpkg = $pdsc->{'Source'}; + $dscver = $pdsc->{'Version'}; + + $self->set_version("${dscpkg}_${dscver}"); + + $build_depends =~ s/\n\s+/ /g if defined $build_depends; + $build_depends_arch =~ s/\n\s+/ /g if defined $build_depends_arch; + $build_depends_indep =~ s/\n\s+/ /g if defined $build_depends_indep; + $build_conflicts =~ s/\n\s+/ /g if defined $build_conflicts; + $build_conflicts_arch =~ s/\n\s+/ /g if defined $build_conflicts_arch; + $build_conflicts_indep =~ s/\n\s+/ /g if defined $build_conflicts_indep; + + $self->set('Build Depends', $build_depends); + $self->set('Build Depends Arch', $build_depends_arch); + $self->set('Build Depends Indep', $build_depends_indep); + $self->set('Build Conflicts', $build_conflicts); + $self->set('Build Conflicts Arch', $build_conflicts_arch); + $self->set('Build Conflicts Indep', $build_conflicts_indep); + + $self->set('Dsc Architectures', $dscarchs); + + # we set up the following filters this late because the user might only + # have specified a source package name to build without a version in which + # case we only get to know the final build directory now + my $filter; + $filter = $self->get('Build Dir') . '/' . $self->get('DSC Dir'); + $filter =~ s;^/;;; + $self->build_log_filter($filter, 'PKGBUILDDIR'); + $filter = $self->get('Build Dir'); + $filter =~ s;^/;;; + $self->build_log_filter($filter, 'BUILDDIR'); + + return 1; +} + +sub check_architectures { + my $self = shift; + my $resolver = $self->get('Dependency Resolver'); + my $dscarchs = $self->get('Dsc Architectures'); + my $build_arch = $self->get('Build Arch'); + my $host_arch = $self->get('Host Arch'); + my $session = $self->get('Session'); + + $self->log_subsection("Check architectures"); + # Check for cross-arch dependencies + # parse $build_depends* for explicit :arch and add the foreign arches, as needed + # + # This check only looks at the immediate build dependencies. This could + # fail in a future where a foreign architecture direct build dependency of + # architecture X depends on another foreign architecture package of + # architecture Y. Architecture Y would not be added through this check as + # sbuild will not traverse the dependency graph. Doing so would be very + # complicated as new architectures would have to be added to a dependency + # solver like dose3 as the graph is traversed and new architectures are + # found. + sub get_explicit_arches + { + my $visited_deps = pop; + my @deps = @_; + + my %set; + for my $dep (@deps) + { + # Break any recursion in the deps data structure (is this overkill?) + next if !defined $dep; + my $id = ref($dep) ? refaddr($dep) : "str:$dep"; + next if $visited_deps->{$id}; + $visited_deps->{$id} = 1; + + if ( exists( $dep->{archqual} ) ) + { + if ( $dep->{archqual} ) + { + $set{$dep->{archqual}} = 1; + } + } + else + { + for my $key (get_explicit_arches($dep->get_deps, + $visited_deps)) { + $set{$key} = 1; + } + } + } + + return keys %set; + } + + # we don't need to look at build conflicts here because conflicting with a + # package of an explicit architecture does not mean that we need to enable + # that architecture in the chroot + my $build_depends_concat = + deps_concat( grep {defined $_} ($self->get('Build Depends'), + $self->get('Build Depends Arch'), + $self->get('Build Depends Indep'))); + my $merged_depends = deps_parse( $build_depends_concat, + reduce_arch => 1, + host_arch => $self->get('Host Arch'), + build_arch => $self->get('Build Arch'), + build_dep => 1, + reduce_profiles => 1, + build_profiles => [ split / /, $self->get('Build Profiles') ]); + if( !defined $merged_depends ) { + my $msg = "Error! deps_parse() couldn't parse the Build-Depends '$build_depends_concat'"; + $self->log_error("$msg\n"); + return 0; + } + + my @explicit_arches = get_explicit_arches($merged_depends, {}); + my @foreign_arches = grep {$_ !~ /any|all|native/} @explicit_arches; + my $added_any_new; + for my $foreign_arch(@foreign_arches) + { + $resolver->add_foreign_architecture($foreign_arch); + $added_any_new = 1; + } + + my @keylist=keys %{$resolver->get('Initial Foreign Arches')}; + $self->log('Initial Foreign Architectures: ' . join ' ', @keylist, "\n") + if @keylist; + $self->log('Foreign Architectures in build-deps: '. join ' ', @foreign_arches, "\n\n") + if @foreign_arches; + + $self->run_chroot_update() if $added_any_new; + + # At this point, all foreign architectures should have been added to dpkg. + # Thus, we now examine, whether the packages passed via --extra-package + # can even be considered by dpkg inside the chroot with respect to their + # architecture. + + # Retrieve all foreign architectures from the chroot. We need to do this + # step because the user might've added more foreign arches to the chroot + # beforehand. + my @all_foreign_arches = split /\s+/, $session->read_command({ + COMMAND => ['dpkg', '--print-foreign-architectures'], + USER => $self->get_conf('USERNAME'), + }); + # we use an anonymous subroutine so that the referenced variables are + # automatically rebound to their current values + my $check_deb_arch = sub { + my $pkg = shift; + # Investigate the Architecture field of the binary package + my $arch = $self->get('Host')->read_command({ + COMMAND => ['dpkg-deb', '--field', Cwd::abs_path($pkg), 'Architecture'], + USER => $self->get_conf('USERNAME') + }); + if (!defined $arch) { + $self->log_warning("Failed to run dpkg-deb on $pkg. Skipping...\n"); + next; + } + chomp $arch; + # Only packages that are Architecture:all, the native architecture or + # one of the configured foreign architectures are allowed. + if ($arch ne 'all' and $arch ne $build_arch + and !isin($arch, @all_foreign_arches)) { + $self->log_warning("Extra package $pkg of architecture $arch cannot be installed in the chroot\n"); + } + }; + for my $deb (@{$self->get_conf('EXTRA_PACKAGES')}) { + if (-f $deb) { + &$check_deb_arch($deb); + } elsif (-d $deb) { + opendir(D, $deb); + while (my $f = readdir(D)) { + next if (! -f "$deb/$f"); + next if ("$deb/$f" !~ /\.deb$/); + &$check_deb_arch("$deb/$f"); + } + closedir(D); + } else { + $self->log_warning("$deb is neither a regular file nor a directory. Skipping...\n"); + } + } + + # Check package arch makes sense to build + if (!$dscarchs) { + $self->log_warning("dsc has no Architecture: field -- skipping arch check!\n"); + } elsif ($self->get_conf('BUILD_SOURCE')) { + # If the source package is to be built, then we do not need to check + # if any of the source package's architectures can be built given the + # current host architecture because then no matter the Architectures + # field, at least the source package will end up getting built. + } else { + my $valid_arch; + for my $a (split(/\s+/, $dscarchs)) { + # Check architecture wildcard matching with dpkg inside the chroot + # to avoid situations in which dpkg outside the chroot doesn't + # know about a new architecture yet + my $command = <<"EOF"; + use strict; + use warnings; + use Dpkg::Arch; + if (Dpkg::Arch::debarch_is('$host_arch', '$a')) { + exit 0; + } + exit 1; +EOF + $session->run_command( + { COMMAND => ['perl', + '-e', + $command], + USER => 'root', + PRIORITY => 0, + DIR => '/' }); + if ($? == 0) { + $valid_arch = 1; + last; + } + } + if ($dscarchs ne "any" && !($valid_arch) && + !($dscarchs =~ /\ball\b/ && $self->get_conf('BUILD_ARCH_ALL')) ) { + my $msg = "dsc: $host_arch not in arch list or does not match any arch wildcards: $dscarchs -- skipping"; + $self->log_error("$msg\n"); + Sbuild::Exception::Build->throw(error => $msg, + status => "skipped", + failstage => "arch-check"); + return 0; + } + } + + $self->log("Arch check ok ($host_arch included in $dscarchs)\n"); + + return 1; +} + +# Subroutine that runs any command through the system (i.e. not through the +# chroot. It takes a string of a command with arguments to run along with +# arguments whether to save STDOUT and/or STDERR to the log stream +sub run_command { + my $self = shift; + my $command = shift; + my $log_output = shift; + my $log_error = shift; + my $chroot = shift; + + # Used to determine if we are to log from commands + my ($out, $err, $defaults); + + # Run the command and save the exit status + if (!$chroot) + { + $defaults = $self->get('Host')->{'Defaults'}; + $out = $defaults->{'STREAMOUT'} if ($log_output); + $err = $defaults->{'STREAMERR'} if ($log_error); + + my %args = (PRIORITY => 0, + STREAMOUT => $out, + STREAMERR => $err); + if(ref $command) { + $args{COMMAND} = \@{$command}; + $args{COMMAND_STR} = "@{$command}"; + } else { + $args{COMMAND} = [split('\s+', $command)]; + $args{COMMAND_STR} = $command; + } + + $self->get('Host')->run_command( \%args ); + } else { + $defaults = $self->get('Session')->{'Defaults'}; + $out = $defaults->{'STREAMOUT'} if ($log_output); + $err = $defaults->{'STREAMERR'} if ($log_error); + + my %args = (USER => 'root', + PRIORITY => 0, + STREAMOUT => $out, + STREAMERR => $err); + if(ref $command) { + $args{COMMAND} = \@{$command}; + $args{COMMAND_STR} = "@{$command}"; + } else { + $args{COMMAND} = [split('\s+', $command)]; + $args{COMMAND_STR} = $command; + } + + $self->get('Session')->run_command( \%args ); + } + my $status = $?; + + # Check if the command failed + if ($status != 0) { + return 0; + } + return 1; +} + +# Subroutine that processes external commands to be run during various stages of +# an sbuild run. We also ask if we want to log any output from the commands +sub run_external_commands { + my $self = shift; + my $stage = shift; + + my $log_output = $self->get_conf('LOG_EXTERNAL_COMMAND_OUTPUT'); + my $log_error = $self->get_conf('LOG_EXTERNAL_COMMAND_ERROR'); + + # Return success now unless there are commands to run + return 1 unless (${$self->get_conf('EXTERNAL_COMMANDS')}{$stage}); + + # Determine which set of commands to run based on the parameter $stage + my @commands = @{${$self->get_conf('EXTERNAL_COMMANDS')}{$stage}}; + return 1 if !(@commands); + + # Create appropriate log message and determine if the commands are to be + # run inside the chroot or not, and as root or not. + my $chroot = 0; + if ($stage eq "pre-build-commands") { + $self->log_subsection("Pre Build Commands"); + } elsif ($stage eq "chroot-setup-commands") { + $self->log_subsection("Chroot Setup Commands"); + $chroot = 1; + } elsif ($stage eq "chroot-update-failed-commands") { + $self->log_subsection("Chroot-update Install Failed Commands"); + $chroot = 1; + } elsif ($stage eq "build-deps-failed-commands") { + $self->log_subsection("Build-Deps Install Failed Commands"); + $chroot = 1; + } elsif ($stage eq "build-failed-commands") { + $self->log_subsection("Generic Build Failed Commands"); + $chroot = 1; + } elsif ($stage eq "starting-build-commands") { + $self->log_subsection("Starting Timed Build Commands"); + $chroot = 1; + } elsif ($stage eq "finished-build-commands") { + $self->log_subsection("Finished Timed Build Commands"); + $chroot = 1; + } elsif ($stage eq "chroot-cleanup-commands") { + $self->log_subsection("Chroot Cleanup Commands"); + $chroot = 1; + } elsif ($stage eq "post-build-commands") { + $self->log_subsection("Post Build Commands"); + } elsif ($stage eq "post-build-failed-commands") { + $self->log_subsection("Post Build Failed Commands"); + } + + # Run each command, substituting the various percent escapes (like + # %SBUILD_DSC) from the commands to run with the appropriate subsitutions. + my $hostarch = $self->get('Host Arch'); + my $buildarch = $self->get('Build Arch'); + my $build_dir = $self->get('Build Dir'); + my $shell_cmd = "bash -i </dev/tty >/dev/tty 2>/dev/tty"; + my %percent = ( + "%" => "%", + "a" => $hostarch, "SBUILD_HOST_ARCH" => $hostarch, + "SBUILD_BUILD_ARCH" => $buildarch, + "b" => $build_dir, "SBUILD_BUILD_DIR" => $build_dir, + "s" => $shell_cmd, "SBUILD_SHELL" => $shell_cmd, + ); + if ($self->get('Changes File')) { + my $changes = $self->get('Changes File'); + $percent{c} = $changes; + $percent{SBUILD_CHANGES} = $changes; + } + # In case set_version has not been run yet, we do not know the dsc file or + # directory yet. This can happen if the user only specified a source + # package name without a version on the command line. + if ($self->get('DSC Dir')) { + my $dsc = $self->get('DSC'); + $percent{d} = $dsc; + $percent{SBUILD_DSC} = $dsc; + my $pkgbuild_dir = $build_dir . '/' . $self->get('DSC Dir'); + $percent{p} = $pkgbuild_dir; + $percent{SBUILD_PKGBUILD_DIR} = $pkgbuild_dir; + } + if ($chroot == 0) { + my $chroot_dir = $self->get('Session')->get('Location'); + $percent{r} = $chroot_dir; + $percent{SBUILD_CHROOT_DIR} = $chroot_dir; + # the %SBUILD_CHROOT_EXEC escape is only defined when the command is + # to be run outside the chroot + my $exec_string = $self->get('Session')->get_internal_exec_string(); + $percent{e} = $exec_string; + $percent{SBUILD_CHROOT_EXEC} = $exec_string; + } + # Our escapes pattern, with longer escapes first, then sorted lexically. + my $keyword_pat = join("|", + sort {length $b <=> length $a || $a cmp $b} keys %percent); + my $returnval = 1; + foreach my $command (@commands) { + + my $substitute = sub { + foreach(@_) { + if (/\%SBUILD_CHROOT_DIR/ || /\%r/) { + $self->log_warning("The %SBUILD_CHROOT_DIR and %r percentage escapes are deprecated and should not be used anymore. Please use %SBUILD_CHROOT_EXEC or %e instead."); + } + s{ + # Match a percent followed by a valid keyword + \%($keyword_pat) + }{ + # Substitute with the appropriate value only if it's defined + $percent{$1} || $& + }msxge; + } + }; + + my $command_str; + if( ref $command ) { + $substitute->(@{$command}); + $command_str = join(" ", @{$command}); + } else { + $substitute->($command); + $command_str = $command; + } + + $self->log_subsubsection("$command_str"); + + $returnval = $self->run_command($command, $log_output, $log_error, $chroot); + $self->log("\n"); + if (!$returnval) { + $self->log_error("Command '$command_str' failed to run.\n"); + # do not run any other commands of this type after the first + # failure + last; + } else { + $self->log_info("Finished running '$command_str'.\n"); + } + } + $self->log("\nFinished processing commands.\n"); + $self->log_sep(); + return $returnval; +} + +sub run_lintian { + my $self = shift; + my $session = $self->get('Session'); + + return 1 unless ($self->get_conf('RUN_LINTIAN')); + $self->set('Lintian Reason', 'error'); + + if (!defined($session)) { + $self->log_error("Session is undef. Cannot run lintian.\n"); + return 0; + } + + $self->log_subsubsection("lintian"); + + my $build_dir = $self->get('Build Dir'); + my $resolver = $self->get('Dependency Resolver'); + my $lintian = $self->get_conf('LINTIAN'); + my $changes = $self->get_changes(); + if (!defined($changes)) { + $self->log_error(".changes is undef. Cannot run lintian.\n"); + return 0; + } + + my @lintian_command = ($lintian); + push @lintian_command, @{$self->get_conf('LINTIAN_OPTIONS')} if + ($self->get_conf('LINTIAN_OPTIONS')); + push @lintian_command, $changes; + + # If the source package was not instructed to be built, then it will not + # be part of the .changes file and thus, the .dsc has to be passed to + # lintian in addition to the .changes file. + if (!$self->get_conf('BUILD_SOURCE')) { + my $dsc = $self->get('DSC File'); + push @lintian_command, $dsc; + } + + $resolver->add_dependencies('LINTIAN', 'lintian:native', "", "", "", "", ""); + return 1 unless $resolver->install_deps('lintian', 'LINTIAN'); + + $self->log("Running lintian...\n"); + + # we are not using read_command() because we also need the output for + # non-zero exit codes + my $pipe = $session->pipe_command( + { COMMAND => \@lintian_command, + PRIORITY => 0, + DIR => $self->get('Build Dir'), + PIPE => "in" + }); + if (!$pipe) { + $self->log_error("Failed to exec Lintian: $!\n"); + return 0; + } + my $lintian_output = ""; + while (my $line = <$pipe>) { + $self->log($line); + $lintian_output .= $line; + } + close $pipe; + + $self->log("\n"); + if ($?) { + my $status = $? >> 8; + my $why = "unknown reason"; + $self->set('Lintian Reason', 'fail') if ($status == 1); + $why = "runtime error" if ($status == 2); + $why = "policy violation" if ($status == 1); + $why = "received signal " . $? & 127 if ($? & 127); + $self->log_error("Lintian run failed ($why)\n"); + + return 0; + } else { + $self->set('Lintian Reason', 'pass'); + if ($lintian_output =~ m/^I: /m) { + $self->set('Lintian Reason', 'info'); + } + if ($lintian_output =~ m/^W: /m) { + $self->set('Lintian Reason', 'warn'); + } + } + + $self->log_info("Lintian run was successful.\n"); + return 1; +} + +sub run_piuparts { + my $self = shift; + + return 1 unless ($self->get_conf('RUN_PIUPARTS')); + $self->set('Piuparts Reason', 'fail'); + + $self->log_subsubsection("piuparts"); + + my $piuparts = $self->get_conf('PIUPARTS'); + my @piuparts_command; + # The default value is the empty array. + # If the value is the default (empty array) prefix with 'sudo --' + # If the value is a non-empty array, prefix with its values except if the + # first value is an empty string in which case, prefix with nothing + # If the value is not an array, prefix with that scalar except if the + # scalar is the empty string in which case, prefix with nothing + if (ref($self->get_conf('PIUPARTS_ROOT_ARGS')) eq "ARRAY") { + if (scalar(@{$self->get_conf('PIUPARTS_ROOT_ARGS')})) { + if (@{$self->get_conf('PIUPARTS_ROOT_ARGS')}[0] ne '') { + push @piuparts_command, @{$self->get_conf('PIUPARTS_ROOT_ARGS')}; + } + } else { + push @piuparts_command, 'sudo', '--'; + } + } else { + if ($self->get_conf('PIUPARTS_ROOT_ARGS') ne '') { + push @piuparts_command, $self->get_conf('PIUPARTS_ROOT_ARGS'); + } + } + push @piuparts_command, $piuparts; + push @piuparts_command, @{$self->get_conf('PIUPARTS_OPTIONS')} if + ($self->get_conf('PIUPARTS_OPTIONS')); + push @piuparts_command, $self->get('Changes File'); + $self->get('Host')->run_command( + { COMMAND => \@piuparts_command, + PRIORITY => 0, + }); + my $status = $? >> 8; + + # We must check for Ctrl+C (and other aborting signals) directly after + # running the command so that we do not mark the piuparts run as successful + # (the exit status will be zero) + $self->check_abort(); + + $self->log("\n"); + + if ($status == 0) { + $self->set('Piuparts Reason', 'pass'); + } else { + $self->log_error("Piuparts run failed.\n"); + return 0; + } + + $self->log_info("Piuparts run was successful.\n"); + return 1; +} + +sub run_autopkgtest { + my $self = shift; + + return 1 unless ($self->get_conf('RUN_AUTOPKGTEST')); + + $self->set('Autopkgtest Reason', 'fail'); + + $self->log_subsubsection("autopkgtest"); + + my $session = $self->get('Session'); + + # sbuild used to check whether debian/tests/control exists and would not + # run autopkgtest at all if it didn't. This is wrong behaviour because + # even packages without a debian/tests/control or packages without a + # Testsuite: field in debian/control might still have autopkgtests as they + # are generated by autodep8. We will not attempt to recreate the autodep8 + # heuristics here and thus we will always run autopkgtest if + # RUN_AUTOPKGTEST was set to true. Also see + # https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=916924 + + my $autopkgtest = $self->get_conf('AUTOPKGTEST'); + my @autopkgtest_command; + # The default value is the empty array. + # If the value is the default (empty array) prefix with 'sudo --' + # If the value is a non-empty array, prefix with its values except if the + # first value is an empty string in which case, prefix with nothing + # If the value is not an array, prefix with that scalar except if the + # scalar is the empty string in which case, prefix with nothing + if (ref($self->get_conf('AUTOPKGTEST_ROOT_ARGS')) eq "ARRAY") { + if (scalar(@{$self->get_conf('AUTOPKGTEST_ROOT_ARGS')}) == 0) { + push @autopkgtest_command, 'sudo', '--'; + } elsif (@{$self->get_conf('AUTOPKGTEST_ROOT_ARGS')}[0] eq '') { + # do nothing if the first array element is the empty string + } else { + push @autopkgtest_command, @{$self->get_conf('AUTOPKGTEST_ROOT_ARGS')}; + } + } elsif ($self->get_conf('AUTOPKGTEST_ROOT_ARGS') eq '') { + # do nothing if the configuration value is the empty string + } else { + push @autopkgtest_command, $self->get_conf('AUTOPKGTEST_ROOT_ARGS'); + } + push @autopkgtest_command, $autopkgtest; + my $tmpdir; + my @cwd_files; + # If the source package was not instructed to be built, then it will not + # be part of the .changes file and thus, the .dsc has to be passed to + # autopkgtest in addition to the .changes file. + if (!$self->get_conf('BUILD_SOURCE')) { + my $dsc = $self->get('DSC'); + # If the source package was downloaded by sbuild, then the .dsc + # and the files it references have to be made available to the + # host + if (! -f $dsc || ! -r $dsc) { + my $build_dir = $self->get('Build Dir'); + $tmpdir = mkdtemp("/tmp/tmp.sbuild.XXXXXXXXXX"); + if (!$session->copy_from_chroot("$build_dir/$dsc", "$tmpdir/$dsc")) { + $self->log_error("cannot copy .dsc from chroot\n"); + rmdir $tmpdir; + return 0; + } + @cwd_files = dsc_files("$tmpdir/$dsc"); + foreach (@cwd_files) { + if (!$session->copy_from_chroot("$build_dir/$_", "$tmpdir/$_")) { + $self->log_error("cannot copy $_ from chroot\n"); + unlink "$tmpdir/$.dsc"; + foreach (@cwd_files) { + unlink "$tmpdir/$_" if -f "$tmpdir/$_"; + } + rmdir $tmpdir; + return 0; + } + } + $dsc = "$tmpdir/$dsc"; + } + push @autopkgtest_command, $dsc; + } + push @autopkgtest_command, $self->get('Changes File'); + if (scalar(@{$self->get_conf('AUTOPKGTEST_OPTIONS')})) { + push @autopkgtest_command, @{$self->get_conf('AUTOPKGTEST_OPTIONS')}; + } else { + push @autopkgtest_command, '--', 'null'; + } + $self->get('Host')->run_command( + { COMMAND => \@autopkgtest_command, + PRIORITY => 0, + }); + my $status = $? >> 8; + # if the source package wasn't built and also initially downloaded by + # sbuild, then the temporary directory that was created must be removed + if (defined $tmpdir) { + my $dsc = $self->get('DSC'); + unlink "$tmpdir/$dsc"; + foreach (@cwd_files) { + unlink "$tmpdir/$_"; + } + rmdir $tmpdir; + } + + # We must check for Ctrl+C (and other aborting signals) directly after + # running the command so that we do not mark the autopkgtest as successful + # (the exit status will be zero) + # But we must check only after the temporary directory has been removed. + $self->check_abort(); + + $self->log("\n"); + + if ($status == 0 || $status == 2) { # 2 is "at least one test was skipped (or at least one flaky test failed)" + $self->set('Autopkgtest Reason', 'pass'); + } elsif ($status == 8) { + $self->set('Autopkgtest Reason', 'no tests'); + } else { + # fail if neither all tests passed nor was the package without tests + $self->log_error("Autopkgtest run failed.\n"); + return 0; + } + + $self->log_info("Autopkgtest run was successful.\n"); + return 1; +} + +sub explain_bd_uninstallable { + my $self = shift; + + my $resolver = $self->get('Dependency Resolver'); + + my $dummy_pkg_name = $resolver->get_sbuild_dummy_pkg_name('main'); + + if (!defined $self->get_conf('BD_UNINSTALLABLE_EXPLAINER')) { + return 0; + } elsif ($self->get_conf('BD_UNINSTALLABLE_EXPLAINER') eq '') { + return 0; + } elsif ($self->get_conf('BD_UNINSTALLABLE_EXPLAINER') eq 'apt') { + my (@instd, @rmvd); + my @apt_args = ('--simulate', \@instd, \@rmvd, 'install', $dummy_pkg_name, + '-oDebug::pkgProblemResolver=true', '-oDebug::pkgDepCache::Marker=1', + '-oDebug::pkgDepCache::AutoInstall=1', '-oDebug::BuildDeps=1' + ); + $resolver->run_apt(@apt_args); + } elsif ($self->get_conf('BD_UNINSTALLABLE_EXPLAINER') eq 'dose3') { + # To retrieve all Packages files apt knows about we use "apt-get + # indextargets" and "apt-helper cat-file". The former is able to + # report the filesystem path of all input Packages files. The latter + # is able to decompress the files if necessary. + # + # We do not use "apt-cache dumpavail" or convert the EDSP output to a + # Packages file because that would make the package selection subject + # to apt pinning. This limitation would be okay if there was only the + # apt resolver but since there also exists the aptitude and aspcud + # resolvers which are able to find solution without pinning + # restrictions, we don't want to limit ourselves by it. In cases where + # apt cannot find a solution, this check is supposed to allow the user + # to know that choosing a different resolver might fix the problem. + $resolver->add_dependencies('DOSE3', 'dose-distcheck:native', "", "", "", "", ""); + if (!$resolver->install_deps('dose3', 'DOSE3')) { + return 0; + } + + my $session = $self->get('Session'); + my $pipe_apt = $session->pipe_command({ + COMMAND => [ 'apt-get', 'indextargets', '--format', '$(FILENAME)', 'Created-By: Packages' ], + USER => $self->get_conf('BUILD_USER'), + }); + if (!$pipe_apt) { + $self->log_error("cannot open reading pipe from apt-get indextargets\n"); + return 0; + } + + my $host = $self->get_conf('HOST_ARCH'); + my $build = $self->get_conf('BUILD_ARCH'); + my @debforeignarg = (); + if ($build ne $host) { + @debforeignarg = ('--deb-foreign-archs', $host); + } + + # - We run dose-debcheck instead of dose-builddebcheck because we want + # to check the dummy binary package created by sbuild instead of the + # original source package Build-Depends. + # - We use dose-debcheck instead of dose-distcheck because we cannot + # use the deb:// prefix on data from standard input. + my $pipe_dose = $session->pipe_command({ + COMMAND => ['dose-debcheck', + '--checkonly', "$dummy_pkg_name:$host", '--verbose', + '--failures', '--successes', '--explain', + '--deb-native-arch', $self->get_conf('BUILD_ARCH'), @debforeignarg ], + PRIORITY => 0, + USER => $self->get_conf('BUILD_USER'), + PIPE => 'out' + }); + if (!$pipe_dose) { + $self->log_error("cannot open writing pipe to dose-debcheck\n"); + return 0; + } + + # We parse file by file instead of concatenating all files because if + # there are many files, we might exceed the maximum command length and + # it avoids having to have the data from all Packages files in memory + # all at once. Working with a smaller Dpkg::Index structure should + # also result in faster store and retrieval times. + while (my $fname = <$pipe_apt>) { + chomp $fname; + my $pipe_cat = $session->pipe_command({ + COMMAND => [ '/usr/lib/apt/apt-helper', 'cat-file', $fname ], + USER => $self->get_conf('BUILD_USER'), + }); + if (!$pipe_cat) { + $self->log_error("cannot open reading pipe from apt-helper\n"); + return 0; + } + + # For native compilation we just pipe the output of apt-helper to + # dose3. For cross compilation we need to filter foreign + # architecture packages that are Essential:yes or + # Multi-Arch:foreign or otherwise dose3 might present a solution + # that installs foreign architecture Essential:yes or + # Multi-Arch:foreign packages. + if ($build eq $host) { + File::Copy::copy $pipe_cat, $pipe_dose; + } else { + my $key_func = sub { + return $_[0]->{Package} . ' ' . $_[0]->{Version} . ' ' . $_[0]->{Architecture}; + }; + + my $index = Dpkg::Index->new(get_key_func=>$key_func); + + if (!$index->parse($pipe_cat, 'apt-helper cat-file')) { + $self->log_error("Cannot parse output of apt-helper cat-file: $!\n"); + return 0; + } + + foreach my $key ($index->get_keys()) { + my $cdata = $index->get_by_key($key); + my $arch = $cdata->{'Architecture'} // ''; + my $ess = $cdata->{'Essential'} // ''; + my $ma = $cdata->{'Multi-Arch'} // ''; + if ($arch ne 'all' && $arch ne $build + && ($ess eq 'yes' || $ma eq 'foreign')) { + next; + } + $cdata->output($pipe_dose); + print $pipe_dose "\n"; + } + } + + close($pipe_cat); + if (($? >> 8) != 0) { + $self->log_error("apt-helper failed\n"); + return 0; + } + } + + close $pipe_dose; + # - We expect an exit code of less than 64 of dose-debcheck. Any other + # exit code indicates abnormal program termination. + if (($? >> 8) >= 64) { + $self->log_error("dose-debcheck failed\n"); + return 0; + } + + close $pipe_apt; + if (($? >> 8) != 0) { + $self->log_error("apt-get indextargets failed\n"); + return 0; + } + + + } + + return 1; +} + +sub build { + my $self = shift; + + my $dscfile = $self->get('DSC File'); + my $dscdir = $self->get('DSC Dir'); + my $pkg = $self->get('Package'); + my $build_dir = $self->get('Build Dir'); + my $host_arch = $self->get('Host Arch'); + my $build_arch = $self->get('Build Arch'); + my $session = $self->get('Session'); + + my( $rv, $changes ); + local( *PIPE, *F, *F2 ); + + $self->log_subsection("Build"); + $self->set('This Space', 0); + + my $tmpunpackdir = $dscdir; + $tmpunpackdir =~ s/-.*$/.orig.tmp-nest/; + $tmpunpackdir =~ s/_/-/; + $tmpunpackdir = "$build_dir/$tmpunpackdir"; + + $dscdir = "$build_dir/$dscdir"; + + $self->log_subsubsection("Unpack source"); + if ($session->test_directory($dscdir) && $session->test_symlink($dscdir)) { + # if the package dir already exists but is a symlink, complain + $self->log_error("Cannot unpack source: a symlink to a directory with the\n". + "same name already exists.\n"); + return 0; + } + my $dsccontent = $session->read_file("$build_dir/$dscfile"); + if (!$dsccontent) { + $self->log_error("Cannot read $build_dir/$dscfile\n"); + } else { + $self->log($dsccontent); + $self->log("\n"); + } + if (!$session->test_directory($dscdir)) { + $self->set('Sub Task', "dpkg-source"); + $session->run_command({ + COMMAND => [$self->get_conf('DPKG_SOURCE'), + '-x', $dscfile, $dscdir], + USER => $self->get_conf('BUILD_USER'), + DIR => $build_dir, + PRIORITY => 0}); + if ($?) { + $self->log_error("FAILED [dpkg-source died]\n"); + Sbuild::Exception::Build->throw(error => "FAILED [dpkg-source died]", + failstage => "unpack"); + } + + if (!$session->chmod($dscdir, 'g-s,go+rX', { RECURSIVE => 1 })) { + $self->log_error("chmod -R g-s,go+rX $dscdir failed.\n"); + Sbuild::Exception::Build->throw(error => "chmod -R g-s,go+rX $dscdir failed", + failstage => "unpack"); + } + } + else { + $self->log_subsubsection("Check unpacked source"); + # check if the unpacked tree is really the version we need + my $clog = $session->read_command( + { COMMAND => ['dpkg-parsechangelog'], + USER => $self->get_conf('BUILD_USER'), + PRIORITY => 0, + DIR => $dscdir}); + if (!$clog) { + $self->log_error("unable to read from dpkg-parsechangelog\n"); + Sbuild::Exception::Build->throw(error => "unable to read from dpkg-parsechangelog", + failstage => "check-unpacked-version"); + } + $self->set('Sub Task', "dpkg-parsechangelog"); + + if ($clog !~ /^Version:\s*(.+)\s*$/mi) { + $self->log_error("dpkg-parsechangelog didn't print Version:\n"); + Sbuild::Exception::Build->throw(error => "dpkg-parsechangelog didn't print Version:", + failstage => "check-unpacked-version"); + } + } + + $self->log_subsubsection("Check disk space"); + chomp(my $current_usage = $session->read_command({ COMMAND => ["du", "-k", "-s", "$dscdir"]})); + if ($?) { + $self->log_error("du exited with non-zero exit status $?\n"); + Sbuild::Exception::Build->throw(error => "du exited with non-zero exit status $?", failstage => "check-space"); + } + $current_usage =~ /^(\d+)/; + $current_usage = $1; + if ($current_usage) { + my $pipe = $session->pipe_command({ COMMAND => ["df", "-k", "$dscdir"]}); + my $free; + while (<$pipe>) { + $free = (split /\s+/)[3]; + } + close $pipe; + if ($?) { + $self->log_error("df exited with non-zero exit status $?\n"); + Sbuild::Exception::Build->throw(error => "df exited with non-zero exit status $?", failstage => "check-space"); + } + if ($free < 2*$current_usage && $self->get_conf('CHECK_SPACE')) { + Sbuild::Exception::Build->throw(error => "Disk space is probably not sufficient for building.", + info => "Source needs $current_usage KiB, while $free KiB is free.)", + failstage => "check-space"); + } else { + $self->log("Sufficient free space for build\n"); + } + } + + my $clogpipe = $session->pipe_command( + { COMMAND => ['dpkg-parsechangelog'], + USER => $self->get_conf('BUILD_USER'), + PRIORITY => 0, + DIR => $dscdir }); + if (!$clogpipe) { + $self->log_error("unable to read from dpkg-parsechangelog\n"); + Sbuild::Exception::Build->throw(error => "unable to read from dpkg-parsechangelog", + failstage => "check-unpacked-version"); + } + + my $clog = Dpkg::Control->new(type => CTRL_CHANGELOG); + if (!$clog->parse($clogpipe, "$dscdir/debian/changelog")) { + $self->log_error("unable to parse debian/changelog\n"); + Sbuild::Exception::Build->throw(error => "unable to parse debian/changelog", + failstage => "check-unpacked-version"); + } + + close($clogpipe); + + my $name = $clog->{Source}; + my $version = $clog->{Version}; + my $dists = $clog->{Distribution}; + my $urgency = $clog->{Urgency}; + + if ($dists ne $self->get_conf('DISTRIBUTION')) { + $self->build_log_colour('yellow', + "^Distribution: " . $self->get_conf('DISTRIBUTION') . "\$"); + } + + if ($self->get_conf('BIN_NMU') || $self->get_conf('APPEND_TO_VERSION') + || defined $self->get_conf('BIN_NMU_CHANGELOG')) { + $self->log_subsubsection("Hack binNMU version"); + + my $text = $session->read_file("$dscdir/debian/changelog"); + + if (!$text) { + $self->log_error("Can't open debian/changelog -- no binNMU hack!\n"); + Sbuild::Exception::Build->throw(error => "Can't open debian/changelog -- no binNMU hack: $!!", + failstage => "hack-binNMU"); + } + + my $NMUversion = $self->get('Version'); + + my $clogpipe = $session->get_write_file_handle("$dscdir/debian/changelog"); + + if (!$clogpipe) { + $self->log_error("Can't open debian/changelog for binNMU hack: $!\n"); + Sbuild::Exception::Build->throw(error => "Can't open debian/changelog for binNMU hack: $!", + failstage => "hack-binNMU"); + } + if (defined $self->get_conf('BIN_NMU_CHANGELOG')) { + my $clogentry = $self->get_conf('BIN_NMU_CHANGELOG'); + # trim leading and trailing whitespace and linebreaks + $clogentry =~ s/^\s+|\s+$//g; + print $clogpipe $clogentry . "\n\n"; + } else { + if (!$self->get_conf('MAINTAINER_NAME')) { + Sbuild::Exception::Build->throw(error => "No maintainer specified.", + info => 'When making changelog additions for a binNMU or appending a version suffix, a maintainer must be specified for the changelog entry e.g. using $maintainer_name, $uploader_name or $key_id, (or the equivalent command-line options)', + failstage => "check-space"); + } + + $dists = $self->get_conf('DISTRIBUTION'); + + print $clogpipe "$name ($NMUversion) $dists; urgency=low, binary-only=yes\n\n"; + if ($self->get_conf('APPEND_TO_VERSION')) { + print $clogpipe " * Append ", $self->get_conf('APPEND_TO_VERSION'), + " to version number; no source changes\n"; + } + if ($self->get_conf('BIN_NMU')) { + print $clogpipe " * Binary-only non-maintainer upload for $host_arch; ", + "no source changes.\n"; + print $clogpipe " * ", join( " ", split( "\n", $self->get_conf('BIN_NMU') )), "\n"; + } + print $clogpipe "\n"; + + # Earlier implementations used the date of the last changelog + # entry for the new entry so that Multi-Arch:same packages would + # be co-installable (their shared changelogs had to match). This + # is not necessary anymore as binNMU changelogs are now written + # into architecture specific paths. Re-using the date of the last + # changelog entry has the disadvantage that this will effect + # SOURCE_DATE_EPOCH which in turn will make the timestamps of the + # files in the new package equal to the last version which can + # confuse backup programs. By using the build date for the new + # binNMU changelog timestamp we make sure that the timestamps of + # changed files inside the new package advanced in comparison to + # the last version. + # + # The timestamp format has to follow Debian Policy §4.4 + # https://www.debian.org/doc/debian-policy/ch-source.html#s-dpkgchangelog + # which is the same format as `date -R` + my $date; + if (defined $self->get_conf('BIN_NMU_TIMESTAMP')) { + if ($self->get_conf('BIN_NMU_TIMESTAMP') =~ /^\+?[1-9]\d*$/) { + $date = strftime_c "%a, %d %b %Y %H:%M:%S +0000", + gmtime($self->get_conf('BIN_NMU_TIMESTAMP')); + } else { + $date = $self->get_conf('BIN_NMU_TIMESTAMP'); + } + } else { + $date = strftime_c "%a, %d %b %Y %H:%M:%S +0000", gmtime(); + } + print $clogpipe " -- " . $self->get_conf('MAINTAINER_NAME') . " $date\n\n"; + } + print $clogpipe $text; + close($clogpipe); + $self->log("Created changelog entry for binNMU version $NMUversion\n"); + } + + if ($session->test_regular_file("$dscdir/debian/files")) { + local( *FILES ); + my @lines; + my $FILES = $session->get_read_file_handle("$dscdir/debian/files"); + chomp( @lines = <$FILES> ); + close( $FILES ); + + $self->log_warning("After unpacking, there exists a file debian/files with the contents:\n"); + + $self->log_sep(); + foreach (@lines) { + $self->log($_); + } + $self->log_sep(); + $self->log("\n"); + + $self->log_info("This should be reported as a bug.\n"); + $self->log_info("The file has been removed to avoid dpkg-genchanges errors.\n"); + + unlink "$dscdir/debian/files"; + } + + # Build tree not writable during build (except for the sbuild + # user performing the build). + if (!$session->chmod($self->get('Build Dir'), 'go-w', { RECURSIVE => 1 })) { + $self->log_error("chmod og-w " . $self->get('Build Dir') . " failed.\n"); + return 0; + } + + if (!$self->run_external_commands("starting-build-commands")) { + Sbuild::Exception::Build->throw(error => "Failed to execute starting-build-commands", + failstage => "run-starting-build-commands"); + } + + $self->set('Build Start Time', time); + $self->set('Build End Time', $self->get('Build Start Time')); + + if ($session->test_regular_file("/etc/ld.so.conf") && + ! $session->test_regular_file_readable("/etc/ld.so.conf")) { + $session->chmod('/etc/ld.so.conf', 'a+r'); + + $self->log_subsubsection("Fix ld.so"); + $self->log("ld.so.conf was not readable! Fixed.\n"); + } + + my $buildcmd = []; + if (length $self->get_conf('BUILD_ENV_CMND') ) { + push( @{$buildcmd}, $self->get_conf('BUILD_ENV_CMND') ); + } + push (@{$buildcmd}, 'dpkg-buildpackage'); + + my $dpkgversion = version->new(0); + { + # we use pipe_command instead of read_command because we want to + # ignore non-zero exit code without printing an error message from + # dpkg versions before 1.20 which didn't have --robot + my $pipe = $session->pipe_command( + { + COMMAND => [ 'dpkg', '--robot', '--version' ], + STREAMERR => $devnull + } + ); + chomp( + my $content = do { local $/; <$pipe> } + ); + close $pipe; + if ( $? == 0 and $content =~ /^([0-9.]+)( .*)?$/ ) { + # dpkg is new enough for the --robot option + $dpkgversion = version->new($1); + } + } + # since dpkg 1.20.0 + # will reset environment and umask to their vendor specific defaults + if ($dpkgversion >= "1.20.0") { + push (@{$buildcmd}, '--sanitize-env'); + } + + if ($host_arch ne $build_arch) { + push (@{$buildcmd}, '-a' . $host_arch); + } + + if (length $self->get_conf('BUILD_PROFILES')) { + my $profiles = $self->get_conf('BUILD_PROFILES'); + $profiles =~ tr/ /,/; + push (@{$buildcmd}, '-P' . $profiles); + } + + if (defined $self->get_conf('PGP_OPTIONS')) { + if (ref($self->get_conf('PGP_OPTIONS')) eq 'ARRAY') { + push (@{$buildcmd}, @{$self->get_conf('PGP_OPTIONS')}); + } elsif (length $self->get_conf('PGP_OPTIONS')) { + push (@{$buildcmd}, $self->get_conf('PGP_OPTIONS')); + } + } + + if (defined $self->get_conf('SIGNING_OPTIONS')) { + if (ref($self->get_conf('SIGNING_OPTIONS')) eq 'ARRAY') { + push (@{$buildcmd}, @{$self->get_conf('SIGNING_OPTIONS')}); + } elsif (length $self->get_conf('SIGNING_OPTIONS')) { + push (@{$buildcmd}, $self->get_conf('SIGNING_OPTIONS')); + } + } + + use constant dpkgopt => [[["", "-B"], ["-A", "-b" ]], [["-S", "-G"], ["-g", ""]]]; + my $binopt = dpkgopt->[$self->get_conf('BUILD_SOURCE')] + [$self->get_conf('BUILD_ARCH_ALL')] + [$self->get_conf('BUILD_ARCH_ANY')]; + push (@{$buildcmd}, $binopt) if $binopt; + push (@{$buildcmd}, "-r" . $self->get_conf('FAKEROOT')); + + if ($self->get_conf('DPKG_FILE_SUFFIX')) { + my $dpkg_version_ok = Dpkg::Version->new("1.18.11"); + if ($self->get('Dpkg Version') >= $dpkg_version_ok) { + my $changes = $self->get_changes(); + push (@{$buildcmd}, "--changes-option=-O../$changes"); + my $buildinfo = $self->get_buildinfo(); + push (@{$buildcmd}, "--buildinfo-option=-O../$buildinfo"); + } else { + $self->log("Ignoring dpkg file suffix: dpkg version too old\n"); + $self->set_conf('DPKG_FILE_SUFFIX',undef); + } + } + + if (defined $self->get_conf('DPKG_BUILDPACKAGE_USER_OPTIONS')) { + push (@{$buildcmd}, @{$self->get_conf('DPKG_BUILDPACKAGE_USER_OPTIONS')}); + } + + # Set up additional build environment variables. + my %buildenv = %{$self->get_conf('BUILD_ENVIRONMENT')}; + $buildenv{'PATH'} = $self->get_conf('PATH'); + $buildenv{'LD_LIBRARY_PATH'} = $self->get_conf('LD_LIBRARY_PATH') + if defined($self->get_conf('LD_LIBRARY_PATH')); + + # Add cross environment config + if ($host_arch ne $build_arch) { + $buildenv{'CONFIG_SITE'} = "/etc/dpkg-cross/cross-config." . $host_arch; + # when cross-building, only set "nocheck" if DEB_BUILD_OPTIONS + # was not already set. This allows overwriting the default by + # setting the DEB_BUILD_OPTIONS environment variable + if (!defined($ENV{'DEB_BUILD_OPTIONS'})) { + $ENV{'DEB_BUILD_OPTIONS'} = "nocheck"; + } + } + + # Explicitly add any needed environment to the environment filter + # temporarily for dpkg-buildpackage. + my @env_filter; + foreach my $envvar (keys %buildenv) { + push(@env_filter, "^$envvar\$"); + } + + # Dump build environment + $self->log_subsubsection("User Environment"); + { + my $envcmd = $session->read_command( + { COMMAND => ['env'], + ENV => \%buildenv, + ENV_FILTER => \@env_filter, + USER => $self->get_conf('BUILD_USER'), + SETSID => 1, + PRIORITY => 0, + DIR => $dscdir + }); + if (!$envcmd) { + $self->log_error("unable to open pipe\n"); + Sbuild::Exception::Build->throw(error => "unable to open pipe", + failstage => "dump-build-env"); + } + + my @lines=sort(split /\n/, $envcmd); + foreach my $line (@lines) { + $self->log("$line\n"); + } + } + + $self->log_subsubsection("dpkg-buildpackage"); + $self->log("Command: " . join(' ', @{$buildcmd}) . "\n"); + + my $command = { + COMMAND => $buildcmd, + ENV => \%buildenv, + ENV_FILTER => \@env_filter, + USER => $self->get_conf('BUILD_USER'), + SETSID => 1, + PRIORITY => 0, + DIR => $dscdir, + STREAMERR => \*STDOUT, + DISABLE_NETWORK => 1, + }; + + my $pipe = $session->pipe_command($command); + if (!$pipe) { + $self->log_error("unable to open pipe\n"); + Sbuild::Exception::Build->throw(error => "unable to open pipe", + failstage => "dpkg-buildpackage"); + } + + $self->set('dpkg-buildpackage pid', $command->{'PID'}); + $self->set('Sub Task', "dpkg-buildpackage"); + + my $timeout = $self->get_conf('INDIVIDUAL_STALLED_PKG_TIMEOUT')->{$pkg} || + $self->get_conf('STALLED_PKG_TIMEOUT'); + $timeout *= 60; + my $timed_out = 0; + my(@timeout_times, @timeout_sigs, $last_time); + + local $SIG{'ALRM'} = sub { + my $pid = $self->get('dpkg-buildpackage pid'); + my $signal = ($timed_out > 0) ? "KILL" : "TERM"; + # negative pid to send to whole process group + kill "$signal", -$pid; + + $timeout_times[$timed_out] = time - $last_time; + $timeout_sigs[$timed_out] = $signal; + $timed_out++; + $timeout = 5*60; # only wait 5 minutes until next signal + }; + + alarm($timeout); + # We do not use a while(<$pipe>) {} loop because that one would only read + # full lines (until $/ is reached). But we do not want to tie "activity" + # to receiving complete lines on standard output and standard error. + # Receiving any data should be sufficient for a process to signal that it + # is still active. Thus, instead of reading lines, we use sysread() which + # will return us data once it is available even if the data is not + # terminated by a newline. To still print correctly to the log, we collect + # unterminated strings into an accumulator and print them to the log once + # the newline shows up. This has the added advantage that we can now not + # only treat \n as producing new lines ($/ is limited to a single + # character) but can also produce new lines when encountering a \r as it + # is common for progress-meter output of long-running processes. + my $acc = ""; + while(1) { + alarm($timeout); + $last_time = time; + # The buffer size is really arbitrary and just makes sure not to call + # this function too often if lots of data is produced by the build. + # The function will immediately return even with less data than the + # buffer size once it is available. + my $ret = sysread($pipe, my $buf, 1024); + # sysread failed - this for example happens when the build timeouted + # and is killed as a result + if (!defined $ret) { + last; + } + # A return value of 0 signals EOF + if ($ret == 0) { + last; + } + # We choose that lines shall not only be terminated by \n but that new + # log lines are also produced after encountering a \r. + # A negative limit is used to also produce trailing empty fields if + # required (think of multiple trailing empty lines). + my @parts = split /\r|\n/, $buf, -1; + my $numparts = scalar @parts; + if ($numparts == 1) { + # line terminator was not found + $acc .= $buf; + } elsif ($numparts >= 2) { + # first match needs special treatment as it needs to be + # concatenated with $acc + my $first = shift @parts; + $self->log($acc . $first . "\n"); + my $last = pop @parts; + for (my $i = 0; $i < $numparts - 2; $i++) { + $self->log($parts[$i] . "\n"); + } + # the last part is put into the accumulator. This might + # just be the empty string if $buf ended in a line + # terminator + $acc = $last; + } + } + # If the output didn't end with a line terminator, just print out the rest + # as we have it. + if ($acc ne "") { + $self->log($acc . "\n"); + } + close($pipe); + alarm(0); + $rv = $?; + $self->set('dpkg-buildpackage pid', undef); + + my $i; + for( $i = 0; $i < $timed_out; ++$i ) { + $self->log_error("Build killed with signal " . $timeout_sigs[$i] . + " after " . int($timeout_times[$i]/60) . + " minutes of inactivity\n"); + } + $self->set('Build End Time', time); + $self->set('Pkg End Time', time); + $self->set('This Time', $self->get('Pkg End Time') - $self->get('Pkg Start Time')); + $self->set('This Time', 0) if $self->get('This Time') < 0; + + $self->write_stats('build-time', + $self->get('Build End Time')-$self->get('Build Start Time')); + $self->write_stats('install-download-time', + $self->get('Install End Time')-$self->get('Install Start Time')); + my $finish_date = strftime_c "%FT%TZ", gmtime($self->get('Build End Time')); + $self->log_sep(); + $self->log("Build finished at $finish_date\n"); + + + if (!$self->run_external_commands("finished-build-commands")) { + Sbuild::Exception::Build->throw(error => "Failed to execute finished-build-commands", + failstage => "run-finished-build-commands"); + } + + my @space_files = (); + + $self->log_subsubsection("Finished"); + if ($rv) { + Sbuild::Exception::Build->throw(error => "Build failure (dpkg-buildpackage died)", + failstage => "build"); + } else { + $self->log_info("Built successfully\n"); + + if ($session->test_regular_file_readable("$dscdir/debian/files")) { + my @files = $self->debian_files_list("$dscdir/debian/files"); + + foreach (@files) { + if (!$session->test_regular_file("$build_dir/$_")) { + $self->log_error("Package claims to have built ".basename($_).", but did not. This is a bug in the packaging.\n"); + next; + } + if (/_all.u?deb$/ and not $self->get_conf('BUILD_ARCH_ALL')) { + $self->log_error("Package builds ".basename($_)." when binary-indep target is not called. This is a bug in the packaging.\n"); + $session->unlink("$build_dir/$_"); + next; + } + } + } + + # Restore write access to build tree now build is complete. + if (!$session->chmod($self->get('Build Dir'), 'g+w', { RECURSIVE => 1 })) { + $self->log_error("chmod g+w " . $self->get('Build Dir') . " failed.\n"); + return 0; + } + + $self->log_subsection("Changes"); + + # we use an anonymous subroutine so that the referenced variables are + # automatically rebound to their current values + my $copy_changes = sub { + my $changes = shift; + + my $F = $session->get_read_file_handle("$build_dir/$changes"); + if (!$F) { + $self->log_error("cannot get read file handle for $build_dir/$changes\n"); + Sbuild::Exception::Build->throw(error => "cannot get read file handle for $build_dir/$changes", + failstage => "parse-changes"); + } + my $pchanges = Dpkg::Control->new(type => CTRL_FILE_CHANGES); + if (!$pchanges->parse($F, "$build_dir/$changes")) { + $self->log_error("cannot parse $build_dir/$changes\n"); + Sbuild::Exception::Build->throw(error => "cannot parse $build_dir/$changes", + failstage => "parse-changes"); + } + close($F); + + + if ($self->get_conf('OVERRIDE_DISTRIBUTION')) { + $pchanges->{Distribution} = $self->get_conf('DISTRIBUTION'); + } + + my $sys_build_dir = $self->get_conf('BUILD_DIR'); + my $F2 = $session->get_write_file_handle("$build_dir/$changes.new"); + if (!$F2) { + $self->log("Cannot create $build_dir/$changes.new\n"); + $self->log("Distribution field may be wrong!!!\n"); + if ($build_dir) { + if(!$session->copy_from_chroot("$build_dir/$changes", ".")) { + $self->log_error("Could not copy $build_dir/$changes to .\n"); + } + } + } else { + $pchanges->output(\*STDOUT); + $pchanges->output(\*$F2); + + close( $F2 ); + + $session->rename("$build_dir/$changes.new", "$build_dir/$changes"); + if ($?) { + $self->log("$build_dir/$changes.new could not be " . + "renamed to $build_dir/$changes: $?\n"); + $self->log("Distribution field may be wrong!!!"); + } + if ($build_dir) { + if (!$session->copy_from_chroot("$build_dir/$changes", "$sys_build_dir")) { + $self->log("Could not copy $build_dir/$changes to $sys_build_dir"); + } + } + } + + return $pchanges; + }; + + $changes = $self->get_changes(); + if (!defined($changes)) { + $self->log_error(".changes is undef. Cannot copy build results.\n"); + return 0; + } + my @cfiles; + if ($session->test_regular_file_readable("$build_dir/$changes")) { + my(@do_dists, @saved_dists); + $self->log_subsubsection("$changes:"); + + my $pchanges = &$copy_changes($changes); + $self->set('Changes File', $self->get_conf('BUILD_DIR') . "/$changes"); + + my $checksums = Dpkg::Checksums->new(); + $checksums->add_from_control($pchanges); + + push(@cfiles, $checksums->get_files()); + + } + else { + $self->log_error("Can't find $changes -- can't dump info\n"); + } + + if ($self->get_conf('SOURCE_ONLY_CHANGES')) { + my $so_changes = $self->get('Package_SVersion') . "_source.changes"; + $self->log_subsubsection("$so_changes:"); + my $genchangescmd = ['dpkg-genchanges', '--build=source']; + if (defined $self->get_conf('SIGNING_OPTIONS')) { + if (ref($self->get_conf('SIGNING_OPTIONS')) eq 'ARRAY') { + push (@{$genchangescmd}, @{$self->get_conf('SIGNING_OPTIONS')}); + } elsif (length $self->get_conf('SIGNING_OPTIONS')) { + push (@{$genchangescmd}, $self->get_conf('SIGNING_OPTIONS')); + } + } + my $changes_opts = $self->get_changes_opts(); + if ($changes_opts) { + push (@{$genchangescmd}, @{$changes_opts}); + } + my $cfile = $session->read_command( + { COMMAND => $genchangescmd, + USER => $self->get_conf('BUILD_USER'), + PRIORITY => 0, + DIR => $dscdir}); + if (!$cfile) { + $self->log_error("dpkg-genchanges --build=source failed\n"); + Sbuild::Exception::Build->throw(error => "dpkg-genchanges --build=source failed", + failstage => "source-only-changes"); + } + if (!$session->write_file("$build_dir/$so_changes", $cfile)) { + $self->log_error("cannot write content to $build_dir/$so_changes\n"); + Sbuild::Exception::Build->throw(error => "cannot write content to $build_dir/$so_changes", + failstage => "source-only-changes"); + } + + my $pchanges = &$copy_changes($so_changes); + } + + $self->log_subsection("Buildinfo"); + + foreach (@cfiles) { + my $deb = "$build_dir/$_"; + next if $deb !~ /\.buildinfo$/; + my $buildinfo = $session->read_file($deb); + if (!$buildinfo) { + $self->log_error("Cannot read $deb\n"); + } else { + $self->log($buildinfo); + $self->log("\n"); + } + } + + $self->log_subsection("Package contents"); + + my @debcfiles = @cfiles; + foreach (@debcfiles) { + my $deb = "$build_dir/$_"; + next if $deb !~ /(\Q$host_arch\E|all)\.(udeb|deb)$/; + + $self->log_subsubsection("$_"); + my $dpkg_info = $session->read_command({COMMAND => ["dpkg", "--info", $deb]}); + if (!$dpkg_info) { + $self->log_error("Can't spawn dpkg: $! -- can't dump info\n"); + } + else { + $self->log($dpkg_info); + } + $self->log("\n"); + my $dpkg_contents = $session->read_command({COMMAND => ["sh", "-c", "dpkg --contents $deb 2>&1 | sort -k6"]}); + if (!$dpkg_contents) { + $self->log_error("Can't spawn dpkg: $! -- can't dump info\n"); + } + else { + $self->log($dpkg_contents); + } + $self->log("\n"); + } + + foreach (@cfiles) { + push( @space_files, $self->get_conf('BUILD_DIR') . "/$_"); + if (!$session->copy_from_chroot("$build_dir/$_", $self->get_conf('BUILD_DIR'))) { + $self->log_error("Could not copy $build_dir/$_ to " . $self->get_conf('BUILD_DIR') . "\n"); + } + } + } + + $self->set('This Space', $self->check_space(@space_files)); + + return $rv == 0 ? 1 : 0; +} + +# Produce a hash suitable for ENV export +sub get_env ($$) { + my $self = shift; + my $prefix = shift; + + sub _env_loop ($$$$) { + my ($env,$ref,$keysref,$prefix) = @_; + + foreach my $key (keys( %{ $keysref } )) { + my $value = $ref->get($key); + next if (!defined($value)); + next if (ref($value)); + my $name = "${prefix}${key}"; + $name =~ s/ /_/g; + $env->{$name} = $value; + } + } + + my $envlist = {}; + _env_loop($envlist, $self, $self, $prefix); + _env_loop($envlist, $self->get('Config'), $self->get('Config')->{'KEYS'}, "${prefix}CONF_"); + return $envlist; +} + +sub get_build_filename { + my $self=shift; + my $filetype=shift; + my $changes = $self->get('Package_SVersion'); + + if ($self->get_conf('BUILD_ARCH_ANY')) { + $changes .= '_' . $self->get('Host Arch'); + } elsif ($self->get_conf('BUILD_ARCH_ALL')) { + $changes .= "_all"; + } elsif ($self->get_conf('BUILD_SOURCE')) { + $changes .= "_source"; + } + + my $suffix = $self->get_conf('DPKG_FILE_SUFFIX'); + $changes .= $suffix if ($suffix); + + $changes .= '.' . $filetype; + + return $changes; +} + +sub get_changes { + my $self=shift; + return $self->get_build_filename("changes"); +} + +sub get_buildinfo { + my $self=shift; + return $self->get_build_filename("buildinfo"); +} + +sub check_space { + my $self = shift; + my @files = @_; + my $sum = 0; + + my $dscdir = $self->get('DSC Dir'); + return -1 unless (defined $dscdir); + + my $build_dir = $self->get('Build Dir'); + my $pkgbuilddir = "$build_dir/$dscdir"; + + # if the source package was not yet unpacked, we will not attempt to compute + # the required space. + return -1 unless ($self->get('Session')->test_directory($pkgbuilddir)); + + my ($space, $spacenum); + + # get the required space for the unpacked source package in the chroot + $space = $self->get('Session')->read_command( + { COMMAND => ['du', '-k', '-s', $pkgbuilddir], + USER => $self->get_conf('USERNAME'), + PRIORITY => 0, + DIR => '/'}); + + if (!$space) { + $self->log_error("Cannot determine space needed for $pkgbuilddir (du failed)\n"); + return -1; + } + # remove the trailing path from the du output + if (($spacenum) = $space =~ /^(\d+)/) { + $sum += $spacenum; + } else { + $self->log_error("Cannot determine space needed for $pkgbuilddir (unexpected du output): $space\n"); + return -1; + } + + # get the required space for all produced build artifacts on the host + # running sbuild + foreach my $file (@files) { + $space = $self->get('Host')->read_command( + { COMMAND => ['du', '-k', '-s', $file], + USER => $self->get_conf('USERNAME'), + PRIORITY => 0, + DIR => '/'}); + + if (!$space) { + $self->log_error("Cannot determine space needed for $file (du failed): $!\n"); + return -1; + } + # remove the trailing path from the du output + if (($spacenum) = $space =~ /^(\d+)/) { + $sum += $spacenum; + } else { + $self->log_error("Cannot determine space needed for $file (unexpected du output): $space\n"); + return -1; + } + } + + return $sum; +} + +sub lock_file { + my $self = shift; + my $file = shift; + my $for_srcdep = shift; + my $lockfile = "$file.lock"; + my $try = 0; + + repeat: + if (!sysopen( F, $lockfile, O_WRONLY|O_CREAT|O_TRUNC|O_EXCL, 0644 )){ + if ($! == EEXIST) { + # lock file exists, wait + goto repeat if !open( F, "<$lockfile" ); + my $line = <F>; + my ($pid, $user); + close( F ); + if ($line !~ /^(\d+)\s+([\w\d.-]+)$/) { + $self->log_warning("Bad lock file contents ($lockfile) -- still trying\n"); + } + else { + ($pid, $user) = ($1, $2); + if (kill( 0, $pid ) == 0 && $! == ESRCH) { + # process doesn't exist anymore, remove stale lock + $self->log_warning("Removing stale lock file $lockfile ". + "(pid $pid, user $user)\n"); + unlink( $lockfile ); + goto repeat; + } + } + ++$try; + if (!$for_srcdep && $try > $self->get_conf('MAX_LOCK_TRYS')) { + $self->log_warning("Lockfile $lockfile still present after " . + $self->get_conf('MAX_LOCK_TRYS') * + $self->get_conf('LOCK_INTERVAL') . + " seconds -- giving up\n"); + return; + } + $self->log("Another sbuild process ($pid by $user) is currently installing or removing packages -- waiting...\n") + if $for_srcdep && $try == 1; + sleep $self->get_conf('LOCK_INTERVAL'); + goto repeat; + } + $self->log_warning("Can't create lock file $lockfile: $!\n"); + } + + my $username = $self->get_conf('USERNAME'); + F->print("$$ $username\n"); + F->close(); +} + +sub unlock_file { + my $self = shift; + my $file = shift; + my $lockfile = "$file.lock"; + + unlink( $lockfile ); +} + +sub add_stat { + my $self = shift; + my $key = shift; + my $value = shift; + + $self->get('Summary Stats')->{$key} = $value; +} + +sub generate_stats { + my $self = shift; + my $resolver = $self->get('Dependency Resolver'); + + $self->add_stat('Job', $self->get('Job')); + $self->add_stat('Package', $self->get('Package')); + # If the package fails early, then the version might not yet be known. + # This can happen if the user only specified a source package name on the + # command line and then the version will only be known after the source + # package was successfully downloaded. + if ($self->get('Version')) { + $self->add_stat('Version', $self->get('Version')); + } + if ($self->get('OVersion')) { + $self->add_stat('Source-Version', $self->get('OVersion')); + } + $self->add_stat('Machine Architecture', $self->get_conf('ARCH')); + $self->add_stat('Host Architecture', $self->get('Host Arch')); + $self->add_stat('Build Architecture', $self->get('Build Arch')); + $self->add_stat('Build Profiles', $self->get('Build Profiles')) + if $self->get('Build Profiles'); + $self->add_stat('Build Type', $self->get('Build Type')); + my @keylist; + if (defined $resolver) { + @keylist=keys %{$resolver->get('Initial Foreign Arches')}; + push @keylist, keys %{$resolver->get('Added Foreign Arches')}; + } + my $foreign_arches = join ' ', @keylist; + $self->add_stat('Foreign Architectures', $foreign_arches ) + if $foreign_arches; + $self->add_stat('Distribution', $self->get_conf('DISTRIBUTION')); + if ($self->get('This Space') >= 0) { + $self->add_stat('Space', $self->get('This Space')); + } else { + $self->add_stat('Space', "n/a"); + } + $self->add_stat('Build-Time', + $self->get('Build End Time')-$self->get('Build Start Time')); + $self->add_stat('Install-Time', + $self->get('Install End Time')-$self->get('Install Start Time')); + $self->add_stat('Package-Time', + $self->get('Pkg End Time')-$self->get('Pkg Start Time')); + if ($self->get('This Space') >= 0) { + $self->add_stat('Build-Space', $self->get('This Space')); + } else { + $self->add_stat('Build-Space', "n/a"); + } + $self->add_stat('Status', $self->get_status()); + $self->add_stat('Fail-Stage', $self->get('Pkg Fail Stage')) + if ($self->get_status() ne "successful"); + $self->add_stat('Lintian', $self->get('Lintian Reason')) + if $self->get('Lintian Reason'); + $self->add_stat('Piuparts', $self->get('Piuparts Reason')) + if $self->get('Piuparts Reason'); + $self->add_stat('Autopkgtest', $self->get('Autopkgtest Reason')) + if $self->get('Autopkgtest Reason'); +} + +sub log_stats { + my $self = shift; + foreach my $stat (sort keys %{$self->get('Summary Stats')}) { + $self->log("${stat}: " . $self->get('Summary Stats')->{$stat} . "\n"); + } +} + +sub print_stats { + my $self = shift; + foreach my $stat (sort keys %{$self->get('Summary Stats')}) { + print STDOUT "${stat}: " . $self->get('Summary Stats')->{$stat} . "\n"; + } +} + +sub write_stats { + my $self = shift; + + return if (!$self->get_conf('BATCH_MODE')); + + my $stats_dir = $self->get_conf('STATS_DIR'); + + return if not defined $stats_dir; + + if (! -d $stats_dir && + !mkdir $stats_dir) { + $self->log_warning("Could not create $stats_dir: $!\n"); + return; + } + + my ($cat, $val) = @_; + local( *F ); + + $self->lock_file($stats_dir, 0); + open( F, ">>$stats_dir/$cat" ); + print F "$val\n"; + close( F ); + $self->unlock_file($stats_dir); +} + +sub debian_files_list { + my $self = shift; + my $files = shift; + + my @list; + + debug("Parsing $files\n"); + my $session = $self->get('Session'); + + my $pipe = $session->get_read_file_handle($files); + if ($pipe) { + while (<$pipe>) { + chomp; + my $f = (split( /\s+/, $_ ))[0]; + push( @list, "$f" ); + debug(" $f\n"); + } + close( $pipe ) or $self->log_error("Failed to close $files\n") && return 1; + } + + return @list; +} + +# Figure out chroot architecture +sub chroot_arch { + my $self = shift; + + chomp(my $chroot_arch = $self->get('Session')->read_command( + { COMMAND => ['dpkg', '--print-architecture'], + USER => $self->get_conf('BUILD_USER'), + PRIORITY => 0, + DIR => '/' })); + + if (!$chroot_arch) { + Sbuild::Exception::Build->throw(error => "Can't determine architecture of chroot: $!", + failstage => "chroot-arch") + } + + return $chroot_arch; +} + +sub build_log_filter { + my $self = shift; + my $text = shift; + my $replacement = shift; + + if ($self->get_conf('LOG_FILTER')) { + $self->log($self->get('FILTER_PREFIX') . $text . ':' . $replacement . "\n"); + } +} + +sub build_log_colour { + my $self = shift; + my $regex = shift; + my $colour = shift; + + if ($self->get_conf('LOG_COLOUR')) { + $self->log($self->get('COLOUR_PREFIX') . $colour . ':' . $regex . "\n"); + } +} + +sub open_build_log { + my $self = shift; + + my $date = strftime_c "%FT%TZ", gmtime($self->get('Pkg Start Time')); + + my $filter_prefix = '__SBUILD_FILTER_' . $$ . ':'; + $self->set('FILTER_PREFIX', $filter_prefix); + my $colour_prefix = '__SBUILD_COLOUR_' . $$ . ':'; + $self->set('COLOUR_PREFIX', $colour_prefix); + + my $filename = $self->get_conf('LOG_DIR') . '/'; + # we might not know the pkgname_ver string if the user only specified a + # package name without version + if ($self->get('Package_SVersion')) { + $filename .= $self->get('Package_SVersion'); + } else { + $filename .= $self->get('Package'); + } + $filename .= '_' . $self->get('Host Arch') . "-$date"; + $filename .= ".build" if $self->get_conf('SBUILD_MODE') ne 'buildd'; + + open($saved_stdout, ">&STDOUT") or warn "Can't redirect stdout\n"; + open($saved_stderr, ">&STDERR") or warn "Can't redirect stderr\n"; + + my $PLOG; + + my $pid; + ($pid = open($PLOG, "|-")); + if (!defined $pid) { + warn "Cannot open pipe to '$filename': $!\n"; + } elsif ($pid == 0) { + $SIG{'INT'} = 'IGNORE'; + $SIG{'TERM'} = 'IGNORE'; + $SIG{'QUIT'} = 'IGNORE'; + $SIG{'PIPE'} = 'IGNORE'; + + $saved_stdout->autoflush(1); + if (!$self->get_conf('NOLOG') && + $self->get_conf('LOG_DIR_AVAILABLE')) { + unlink $filename; # To prevent opening symlink to elsewhere + open( CPLOG, ">$filename" ) or + Sbuild::Exception::Build->throw(error => "Failed to open build log $filename: $!", + failstage => "init"); + CPLOG->autoflush(1); + + # Create 'current' symlinks + if ($self->get_conf('SBUILD_MODE') eq 'buildd') { + $self->log_symlink($filename, + $self->get_conf('BUILD_DIR') . '/current-' . + $self->get_conf('DISTRIBUTION')); + } else { + my $symlinktarget = $filename; + # if symlink target is in the same directory as the symlink + # itself, make it a relative link instead of an absolute one + if (Cwd::abs_path($self->get_conf('BUILD_DIR')) eq Cwd::abs_path(dirname($filename))) { + $symlinktarget = basename($filename) + } + my $symlinkname = $self->get_conf('BUILD_DIR') . '/'; + # we might not know the pkgname_ver string if the user only specified a + # package name without version + if ($self->get('Package_SVersion')) { + $symlinkname .= $self->get('Package_SVersion'); + } else { + $symlinkname .= $self->get('Package'); + } + $symlinkname .= '_' . $self->get('Host Arch') . ".build"; + $self->log_symlink($symlinktarget, $symlinkname); + } + } + + # Cache vars to avoid repeated hash lookups. + my $nolog = $self->get_conf('NOLOG'); + my $log = $self->get_conf('LOG_DIR_AVAILABLE'); + my $verbose = $self->get_conf('VERBOSE'); + my $log_colour = $self->get_conf('LOG_COLOUR'); + my @filter = (); + my @colour = (); + my ($text, $replacement); + my $filter_regex = "^$filter_prefix(.*):(.*)\$"; + my $colour_regex = "^$colour_prefix(.*):(.*)\$"; + my @ignore = (); + + while (<STDIN>) { + # Add a replacement pattern to filter (sent from main + # process in log stream). + if (m/$filter_regex/) { + ($text,$replacement)=($1,$2); + $replacement = "<<$replacement>>"; + push (@filter, [$text, $replacement]); + $_ = "I: NOTICE: Log filtering will replace '$text' with '$replacement'\n"; + } elsif (m/$colour_regex/) { + my ($colour, $regex); + ($colour,$regex)=($1,$2); + push (@colour, [$colour, $regex]); +# $_ = "I: NOTICE: Log colouring will colour '$regex' in $colour\n"; + next; + } else { + # Filter out any matching patterns + foreach my $pattern (@filter) { + ($text,$replacement) = @{$pattern}; + s/\Q$text\E/$replacement/g; + } + } + if (m/Deprecated key/ || m/please update your configuration/) { + my $skip = 0; + foreach my $ignore (@ignore) { + $skip = 1 if ($ignore eq $_); + } + next if $skip; + push(@ignore, $_); + } + + if ($nolog || $verbose) { + my $colour = 'reset'; + if (-t $saved_stdout && $log_colour) { + foreach my $pattern (@colour) { + if (m/$$pattern[0]/) { + $colour = $$pattern[1]; + } + } + if ($colour ne 'reset') { + print $saved_stdout color $colour; + } + } + + print $saved_stdout $_; + if (-t $saved_stdout && $log_colour && $colour ne 'reset') { + print $saved_stdout color 'reset'; + } + } + if (!$nolog && $log) { + print CPLOG $_; + } + } + + close CPLOG; + exit 0; + } + + $PLOG->autoflush(1); + open(STDOUT, '>&', $PLOG) or warn "Can't redirect stdout\n"; + open(STDERR, '>&', $PLOG) or warn "Can't redirect stderr\n"; + $self->set('Log File', $filename); + $self->set('Log Stream', $PLOG); + + my $hostname = $self->get_conf('HOSTNAME'); + $self->log("sbuild (Debian sbuild) $version ($release_date) on $hostname\n"); + + my $arch_string = $self->get('Host Arch'); + my $head1 = $self->get('Package'); + if ($self->get('Version')) { + $head1 .= ' ' . $self->get('Version'); + } + $head1 .= ' (' . $arch_string . ') '; + my $head2 = strftime_c "%a, %d %b %Y %H:%M:%S +0000", + gmtime($self->get('Pkg Start Time')); + my $head = $head1; + # If necessary, insert spaces so that $head1 is left aligned and $head2 is + # right aligned. If the sum of the length of both is greater than the + # available space of 76 characters, then no additional padding is + # inserted. + if (length($head1) + length($head2) <= 76) { + $head .= ' ' x (76 - length($head1) - length($head2)); + } + $head .= $head2; + $self->log_section($head); + + $self->log("Package: " . $self->get('Package') . "\n"); + if (defined $self->get('Version')) { + $self->log("Version: " . $self->get('Version') . "\n"); + } + if (defined $self->get('OVersion')) { + $self->log("Source Version: " . $self->get('OVersion') . "\n"); + } + $self->log("Distribution: " . $self->get_conf('DISTRIBUTION') . "\n"); + $self->log("Machine Architecture: " . $self->get_conf('ARCH') . "\n"); + $self->log("Host Architecture: " . $self->get('Host Arch') . "\n"); + $self->log("Build Architecture: " . $self->get('Build Arch') . "\n"); + $self->log("Build Profiles: " . $self->get('Build Profiles') . "\n") if $self->get('Build Profiles'); + $self->log("Build Type: " . $self->get('Build Type') . "\n"); + $self->log("\n"); +} + +sub close_build_log { + my $self = shift; + + my $time = $self->get('Pkg End Time'); + if ($time == 0) { + $time = time; + } + my $date = strftime_c "%FT%TZ", gmtime($time); + + my $hours = int($self->get('This Time')/3600); + my $minutes = int(($self->get('This Time')%3600)/60), + my $seconds = int($self->get('This Time')%60), + my $space = "no"; + if ($self->get('This Space') >= 0) { + $space = sprintf("%dk", $self->get('This Space')); + } + + my $filename = $self->get('Log File'); + + # building status at this point means failure. + if ($self->get_status() eq "building") { + $self->set_status('failed'); + } + + $self->log_subsection('Summary'); + $self->generate_stats(); + $self->log_stats(); + + $self->log_sep(); + $self->log("Finished at ${date}\n"); + $self->log(sprintf("Build needed %02d:%02d:%02d, %s disk space\n", + $hours, $minutes, $seconds, $space)); + + if ($self->get_status() eq "successful") { + if (length $self->get_conf('KEY_ID')) { + my $key_id = $self->get_conf('KEY_ID'); + my $build_dir = $self->get_conf('BUILD_DIR'); + my $changes; + $self->log(sprintf("Signature with key '%s' requested:\n", $key_id)); + $changes = $self->get_changes(); + if (!defined($changes)) { + $self->log_error(".changes is undef. Cannot sign .changes.\n"); + } else { + system('debsign', '--re-sign', "-k$key_id", '--', "$build_dir/$changes"); + } + if ($self->get_conf('SOURCE_ONLY_CHANGES')) { + # We would like to run debsign with --no-re-sign so that a file + # referenced by the normal changes file and was already signed + # there does not get changed here by re-signing. Otherwise, the + # checksum from the normal changes file might not match + # anymore. https://bugs.debian.org/977674 + # + # The problem is, that with --no-re-sign, debsign will see a + # signed buildinfo file and skip signing the dsc. + # https://bugs.debian.org/981021 + my $so_changes = $build_dir . '/' . $self->get('Package_SVersion') . "_source.changes"; + if (-r $so_changes) { + system('debsign', '--re-sign', "-k$key_id", '--', "$so_changes"); + } else { + $self->log_error("$so_changes unreadable. Cannot sign .changes.\n"); + } + } + } + } + + my $subject = "Log for " . $self->get_status() . " build of "; + if ($self->get('Package_Version')) { + $subject .= $self->get('Package_Version'); + } else { + $subject .= $self->get('Package'); + } + + if ($self->get_conf('BUILD_SOURCE') && !$self->get_conf('BUILD_ARCH_ALL') && !$self->get_conf('BUILD_ARCH_ANY')) { + $subject .= " source"; + } + if ($self->get_conf('BUILD_ARCH_ALL') && !$self->get_conf('BUILD_ARCH_ANY')) { + $subject .= " on all"; + } elsif ($self->get('Host Arch')) { + $subject .= " on " . $self->get('Host Arch'); + } + if ($self->get_conf('ARCHIVE')) { + $subject .= " (" . $self->get_conf('ARCHIVE') . "/" . $self->get_conf('DISTRIBUTION') . ")"; + } + else { + $subject .= " (dist=" . $self->get_conf('DISTRIBUTION') . ")"; + } + + open(STDERR, '>&', $saved_stderr) or warn "Can't redirect stderr\n" + if defined($saved_stderr); + open(STDOUT, '>&', $saved_stdout) or warn "Can't redirect stdout\n" + if defined($saved_stdout); + $saved_stderr->close(); + undef $saved_stderr; + $saved_stdout->close(); + undef $saved_stdout; + $self->set('Log File', undef); + if (defined($self->get('Log Stream'))) { + $self->get('Log Stream')->close(); # Close child logger process + $self->set('Log Stream', undef); + } + + $self->send_build_log($self->get_conf('MAILTO'), $subject, $filename) + if (defined($filename) && -f $filename && + $self->get_conf('MAILTO')); +} + +sub send_build_log { + my $self = shift; + my $to = shift; + my $subject = shift; + my $filename = shift; + + my $conf = $self->get('Config'); + + if ($conf->get('MIME_BUILD_LOG_MAILS')) { + return $self->send_mime_build_log($to, $subject, $filename); + } else { + return send_mail($conf, $to, $subject, $filename); + } +} + +sub send_mime_build_log { + my $self = shift; + my $to = shift; + my $subject = shift; + my $filename = shift; + + my $conf = $self->get('Config'); + my $tmp; # Needed for gzip, here for proper scoping. + + my $msg = MIME::Lite->new( + From => $conf->get('MAILFROM'), + To => $to, + Subject => $subject, + Type => 'multipart/mixed' + ); + + # Add the GPG key ID to the mail if present so that it's clear if the log + # still needs signing or not. + if (length $self->get_conf('KEY_ID')) { + $msg->add('Key-ID', $self->get_conf('KEY_ID')); + } + + if (!$conf->get('COMPRESS_BUILD_LOG_MAILS')) { + my $log_part = MIME::Lite->new( + Type => 'text/plain', + Path => $filename, + Filename => basename($filename) + ); + $log_part->attr('content-type.charset' => 'UTF-8'); + $msg->attach($log_part); + } else { + local( *F, *GZFILE ); + + if (!open( F, "<$filename" )) { + warn "Cannot open $filename for mailing: $!\n"; + return 0; + } + + $tmp = File::Temp->new(); + tie *GZFILE, 'IO::Zlib', $tmp->filename, 'wb'; + + while( <F> ) { + print GZFILE $_; + } + untie *GZFILE; + + close F; + close GZFILE; + + $msg->attach( + Type => 'application/x-gzip', + Path => $tmp->filename, + Filename => basename($filename) . '.gz' + ); + } + my $build_dir = $self->get_conf('BUILD_DIR'); + my $changes = $self->get_changes(); + if ($self->get_status() eq 'successful' && -r "$build_dir/$changes") { + my $log_part = MIME::Lite->new( + Type => 'text/plain', + Path => "$build_dir/$changes", + Filename => basename($changes) + ); + $log_part->attr('content-type.charset' => 'UTF-8'); + $msg->attach($log_part); + } + + my $stats = ''; + foreach my $stat (sort keys %{$self->get('Summary Stats')}) { + $stats .= sprintf("%s: %s\n", $stat, $self->get('Summary Stats')->{$stat}); + } + $msg->attach( + Type => 'text/plain', + Filename => basename($filename) . '.summary', + Data => $stats + ); + + local $SIG{'PIPE'} = 'IGNORE'; + + if (!open( MAIL, "|" . $conf->get('MAILPROG') . " -oem $to" )) { + warn "Could not open pipe to " . $conf->get('MAILPROG') . ": $!\n"; + close( F ); + return 0; + } + + $msg->print(\*MAIL); + + if (!close( MAIL )) { + warn $conf->get('MAILPROG') . " failed (exit status $?)\n"; + return 0; + } + return 1; +} + +sub log_symlink { + my $self = shift; + my $log = shift; + my $dest = shift; + + unlink $dest; # Don't return on failure, since the symlink will fail. + symlink $log, $dest; +} + +sub get_changes_opts { + my $self = shift; + my @changes_opts = (); + foreach (@{$self->get_conf('DPKG_BUILDPACKAGE_USER_OPTIONS')}) { + if (/^--changes-option=(.*)$/) { + push @changes_opts, $1; + } elsif (/^-s[iad]$/) { + push @changes_opts, $_; + } elsif (/^--build=.*$/) { + push @changes_opts, $_; + } elsif (/^-m.*$/) { + push @changes_opts, $_; + } elsif (/^-e.*$/) { + push @changes_opts, $_; + } elsif (/^-v.*$/) { + push @changes_opts, $_; + } elsif (/^-C.*$/) { + push @changes_opts, $_; + } + } + + return \@changes_opts; +} + +1; diff --git a/lib/Sbuild/Chroot.pm b/lib/Sbuild/Chroot.pm new file mode 100644 index 0000000..018e199 --- /dev/null +++ b/lib/Sbuild/Chroot.pm @@ -0,0 +1,963 @@ +# +# Chroot.pm: chroot library for sbuild +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2005-2008 Roger Leigh <rleigh@debian.org> +# Copyright © 2008 Simon McVittie <smcv@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::Chroot; + +use Sbuild qw(copy debug debug2); +use Sbuild::Base; +use Sbuild::ChrootInfo; +use Sbuild::ChrootSetup qw(basesetup); +use Sbuild qw($devnull shellescape); + +use strict; +use warnings; +use POSIX; +use FileHandle; +use File::Temp (); +use File::Basename qw(basename); + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::Base); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + my $chroot_id = shift; + + my $self = $class->SUPER::new($conf); + bless($self, $class); + + my @filter; + @filter = @{$self->get_conf('ENVIRONMENT_FILTER')} + if (defined($self->get_conf('ENVIRONMENT_FILTER'))); + + $self->set('Session ID', ""); + $self->set('Chroot ID', $chroot_id) if defined $chroot_id; + $self->set('Defaults', { + 'COMMAND' => [], + 'INTCOMMAND' => [], # Private + 'EXPCOMMAND' => [], # Private + 'ENV' => {}, + 'ENV_FILTER' => \@filter, + 'USER' => 'root', + 'CHROOT' => 1, + 'PRIORITY' => 0, + 'DIR' => '/', + 'SETSID' => 0, + 'STREAMIN' => undef, + 'STREAMOUT' => undef, + 'STREAMERR' => undef}); + + return $self; +} + +sub _setup_options { + my $self = shift; + + if (basesetup($self, $self->get('Config'))) { + print STDERR "Failed to set up chroot\n"; + return 0; + } + + return 1; +} + +sub get_option { + my $self = shift; + my $options = shift; + my $option = shift; + + my $value = undef; + $value = $self->get('Defaults')->{$option} if + (defined($self->get('Defaults')) && + defined($self->get('Defaults')->{$option})); + $value = $options->{$option} if + (defined($options) && + exists($options->{$option})); + + return $value; +} + +sub log_command { + my $self = shift; + my $options = shift; + + my $priority = $options->{'PRIORITY'}; + + if ((defined($priority) && $priority >= 1) || $self->get_conf('DEBUG')) { + my $command; + if ($self->get_conf('DEBUG')) { + $command = $options->{'EXPCOMMAND'}; + } else { + $command = $options->{'COMMAND'}; + } + + $self->log_info(join(" ", @$command), "\n"); + } +} + +# create a temporary file or directory inside the chroot +sub mktemp { + my $self = shift; + my $options = shift; + + my $user = "root"; + $user = $options->{'USER'} if defined $options->{'USER'}; + + my $dir = "/"; + $dir = $options->{'DIR'} if defined $options->{'DIR'}; + + my $mktempcmd = ['mktemp']; + + if (defined $options->{'DIRECTORY'} && $options->{'DIRECTORY'}) { + push(@{$mktempcmd}, "-d"); + } + + if (defined $options->{'TEMPLATE'}) { + push(@{$mktempcmd}, $options->{'TEMPLATE'}); + } + + my $pipe = $self->pipe_command({ COMMAND => $mktempcmd, USER => $user, DIR => $dir }); + if (!$pipe) { + $self->log_error("cannot open pipe\n"); + return; + } + chomp (my $tmpdir = do { local $/; <$pipe> }); + close $pipe; + if ($?) { + if (defined $options->{'TEMPLATE'}) { + $self->log_error("cannot run mktemp " . $options->{'TEMPLATE'} . ": $!\n"); + } else { + $self->log_error("cannot run mktemp: $!\n"); + } + return; + } + return $tmpdir; +} + +# copy a file from the outside into the chroot +sub copy_to_chroot { + my $self = shift; + my $source = shift; + my $dest = shift; + my $options = shift; + + # if the destination inside the chroot is a directory, then the file has + # to be copied into that directory with the same filename as outside + if($self->test_directory($dest)) { + $dest .= '/' . (basename $source); + } + + my $pipe = $self->get_write_file_handle($dest, $options); + if (!defined $pipe) { + $self->log_error("get_write_file_handle failed\n"); + return; + } + + local *INFILE; + if(!open(INFILE, "<", $source)) { + $self->log_error("cannot open $source\n"); + close $pipe; + return; + } + + while ( (read (INFILE, my $buffer, 65536)) != 0 ) { + print $pipe $buffer; + } + + close INFILE; + close $pipe; + + return 1; +} + +# copy a file inside the chroot to the outside +sub copy_from_chroot { + my $self = shift; + my $source = shift; + my $dest = shift; + my $options = shift; + + my $pipe = $self->get_read_file_handle($source, $options); + if (!defined $pipe) { + $self->log_error("get_read_file_handle failed\n"); + return; + } + + # if the destination outside the chroot is a directory, then the file has + # to be copied into that directory with the same filename as inside + if (-d $dest) { + $dest .= '/' . (basename $source); + } + + local *OUTFILE; + if(!open(OUTFILE, ">", $dest)) { + $self->log_error("cannot open $dest\n"); + close $pipe; + return; + } + + while ( (read ($pipe, my $buffer, 65536)) != 0 ) { + print OUTFILE $buffer; + } + + close OUTFILE; + close $pipe; + + return 1; +} + +# returns a file handle to read a file inside the chroot +sub get_read_file_handle { + my $self = shift; + my $source = shift; + my $options = shift; + + my $user = "root"; + $user = $options->{'USER'} if defined $options->{'USER'}; + + my $dir = "/"; + $dir = $options->{'DIR'} if defined $options->{'DIR'}; + + my $escapedsource = shellescape $source; + + my $pipe = $self->pipe_command({ + COMMAND => [ "sh", "-c", "cat $escapedsource" ], + DIR => $dir, + USER => $user, + PIPE => 'in' + }); + if (!$pipe) { + $self->log_error("cannot open pipe\n"); + return; + } + + return $pipe; +} + +# returns a string with the content of a file inside the chroot +sub read_file { + my $self = shift; + my $source = shift; + my $options = shift; + + my $pipe = $self->get_read_file_handle($source, $options); + if (!defined $pipe) { + $self->log_error("get_read_file_handle failed\n"); + return; + } + + my $content = do { local $/; <$pipe> }; + close $pipe; + + return $content; +} + +# returns a file handle to write to a file inside the chroot +sub get_write_file_handle { + my $self = shift; + my $dest = shift; + my $options = shift; + + my $user = "root"; + $user = $options->{'USER'} if defined $options->{'USER'}; + + my $dir = "/"; + $dir = $options->{'DIR'} if defined $options->{'DIR'}; + + my $escapeddest = shellescape $dest; + + my $pipe = $self->pipe_command({ + COMMAND => [ "sh", "-c", "cat > $escapeddest" ], + DIR => $dir, + USER => $user, + PIPE => 'out' + }); + if (!$pipe) { + $self->log_error("cannot open pipe\n"); + return; + } + + return $pipe; +} + +sub read_command { + my $self = shift; + my $options = shift; + + $options->{PIPE} = "in"; + + my $pipe = $self->pipe_command($options); + if (!$pipe) { + $self->log_error("cannot open pipe\n"); + return; + } + + my $content = do { local $/; <$pipe> }; + close $pipe; + + if ($?) { + $self->log_error("read_command failed to execute " . $options->{COMMAND}->[0] . "\n"); + return; + } + + return $content; +} + +# writes a string to a file inside the chroot +sub write_file { + my $self = shift; + my $dest = shift; + my $content = shift; + my $options = shift; + + my $pipe = $self->get_write_file_handle($dest, $options); + if (!defined $pipe) { + $self->log_error("get_read_file_handle failed\n"); + return; + } + + print $pipe $content; + close $pipe; + + return 1; +} + +sub write_command { + my $self = shift; + my $content = shift; + my $options = shift; + + $options->{PIPE} = "out"; + + my $pipe = $self->pipe_command($options); + if (!$pipe) { + $self->log_error("cannot open pipe\n"); + return; + } + + if(!print $pipe $content) { + $self->log_error("failed to print to file handle\n"); + close $pipe; + } + + close $pipe; + + if ($?) { + $self->log_error("write_command failed to execute " . $options->{COMMAND}->[0] . "\n"); + return; + } + + return 1; +} + +# rename a file inside the chroot +sub rename { + my $self = shift; + my $source = shift; + my $dest = shift; + my $options = shift; + + my $user = "root"; + $user = $options->{'USER'} if defined $options->{'USER'}; + + my $dir = "/"; + $dir = $options->{'DIR'} if defined $options->{'DIR'}; + + $self->run_command({ COMMAND => ["mv", $source, $dest], USER => $user, DIR => $dir}); + if ($?) { + $self->log_error("Can't rename $source to $dest: $!\n"); + return 0; + } + + return 1; +} + +# create a directory inside the chroot +sub mkdir { + my $self = shift; + my $path = shift; + my $options = shift; + + my $user = "root"; + $user = $options->{'USER'} if defined $options->{'USER'}; + + my $dir = "/"; + $dir = $options->{'DIR'} if defined $options->{'DIR'}; + + my $mkdircmd = [ "mkdir", $path ]; + + if (defined $options->{'PARENTS'} && $options->{'PARENTS'}) { + push(@{$mkdircmd}, "-p"); + } + + if (defined $options->{'MODE'}) { + push(@{$mkdircmd}, "--mode", $options->{'MODE'}); + } + + $self->run_command({ COMMAND => $mkdircmd, USER => $user, DIR => $dir}); + if ($?) { + $self->log_error("Can't mkdir $path: $!\n"); + return 0; + } + + return 1; +} + +sub test_internal { + my $self = shift; + my $path = shift; + my $arg = shift; + my $options = shift; + + my $user = "root"; + $user = $options->{'USER'} if defined $options->{'USER'}; + + my $dir = "/"; + $dir = $options->{'DIR'} if defined $options->{'DIR'}; + + $self->run_command({ COMMAND => [ "test", $arg, $path ], USER => $user, DIR => $dir}); + if ($? eq 0) { + return 1; + } else { + return 0; + } +} + +# test if a path inside the chroot is a directory +sub test_directory { + my $self = shift; + my $path = shift; + my $options = shift; + + return $self->test_internal($path, "-d", $options); +} + +# test if a path inside the chroot is a regular file +sub test_regular_file { + my $self = shift; + my $path = shift; + my $options = shift; + + return $self->test_internal($path, "-f", $options); +} + +# test if a path inside the chroot is a regular readable file +sub test_regular_file_readable { + my $self = shift; + my $path = shift; + my $options = shift; + + return $self->test_internal($path, "-r", $options); +} + +# test if a path inside the chroot is a symlink +sub test_symlink { + my $self = shift; + my $path = shift; + my $options = shift; + + return $self->test_internal($path, "-L", $options); +} + +# remove a file inside the chroot +sub unlink { + my $self = shift; + my $path = shift; + my $options = shift; + + my $user = "root"; + $user = $options->{'USER'} if defined $options->{'USER'}; + + my $dir = "/"; + $dir = $options->{'DIR'} if defined $options->{'DIR'}; + + my $rmcmd = [ "rm", $path ]; + + if (defined $options->{'RECURSIVE'} && $options->{'RECURSIVE'}) { + push(@{$rmcmd}, "-r"); + } + + if (defined $options->{'FORCE'} && $options->{'FORCE'}) { + push(@{$rmcmd}, "-f"); + } + + if (defined $options->{'DIRECTORY'} && $options->{'DIRECTORY'}) { + push(@{$rmcmd}, "-d"); + } + + $self->run_command({ COMMAND => $rmcmd, USER => $user, DIR => $dir}); + if ($?) { + $self->log_error("Can't unlink $path: $!\n"); + return 0; + } + + return 1; +} + +# chmod a path inside the chroot +sub chmod { + my $self = shift; + my $path = shift; + my $mode = shift; + my $options = shift; + + my $user = "root"; + $user = $options->{'USER'} if defined $options->{'USER'}; + + my $dir = "/"; + $dir = $options->{'DIR'} if defined $options->{'DIR'}; + + my $chmodcmd = [ "chmod" ]; + + if (defined $options->{'RECURSIVE'} && $options->{'RECURSIVE'}) { + push(@{$chmodcmd}, "-R"); + } + + push(@{$chmodcmd}, $mode, $path); + + $self->run_command({ COMMAND => $chmodcmd, USER => $user, DIR => $dir}); + if ($?) { + $self->log_error("Can't chmod $path to $mode: $!\n"); + return 0; + } + + return 1; +} + +# chown a path inside the chroot +sub chown { + my $self = shift; + my $path = shift; + my $owner = shift; + my $group = shift; + my $options = shift; + + my $user = "root"; + $user = $options->{'USER'} if defined $options->{'USER'}; + + my $dir = "/"; + $dir = $options->{'DIR'} if defined $options->{'DIR'}; + + my $chowncmd = [ "chown" ]; + + if (defined $options->{'RECURSIVE'} && $options->{'RECURSIVE'}) { + push(@{$chowncmd}, "-R"); + } + + push(@{$chowncmd}, "$owner:$group", $path); + + $self->run_command({ COMMAND => $chowncmd, USER => $user, DIR => $dir}); + if ($?) { + $self->log_error("Can't chown $path to $owner:$group: $!\n"); + return 0; + } + + return 1; +} + +# test if a program inside the chroot can be run +# we use the function name "can_run" as it is similar to the function in +# IPC::Cmd +sub can_run { + my $self = shift; + my $program = shift; + my $options = shift; + + my $user = "root"; + $user = $options->{'USER'} if defined $options->{'USER'}; + + my $dir = "/"; + $dir = $options->{'DIR'} if defined $options->{'DIR'}; + + my $escapedprogram = shellescape $program; + + my $commandcmd = [ 'sh', '-c', "command -v $escapedprogram >/dev/null 2>&1" ]; + + $self->run_command({ COMMAND => $commandcmd, USER => $user, DIR => $dir}); + if ($?) { + return 0; + } + + return 1; +} + +# Note, do not run with $user="root", and $chroot=0, because root +# access to the host system is not allowed by schroot, nor required +# via sudo. +sub pipe_command_internal { + my $self = shift; + my $options = shift; + + my $pipetype = "-|"; + $pipetype = "|-" if (defined $options->{'PIPE'} && + $options->{'PIPE'} eq 'out'); + + my $pipe = undef; + my $pid = open($pipe, $pipetype); + if (!defined $pid) { + warn "Cannot open pipe: $!\n"; + } elsif ($pid == 0) { # child + if (!defined $options->{'PIPE'} || + $options->{'PIPE'} ne 'out') { # redirect stdin + my $in = $self->get_option($options, 'STREAMIN'); + if (defined($in) && $in && \*STDIN != $in) { + open(STDIN, '<&', $in) + or warn "Can't redirect stdin\n"; + } + } else { # redirect stdout + my $out = $self->get_option($options, 'STREAMOUT'); + if (defined($out) && $out && \*STDOUT != $out) { + open(STDOUT, '>&', $out) + or warn "Can't redirect stdout\n"; + } + } + # redirect stderr + my $err = $self->get_option($options, 'STREAMERR'); + if (defined($err) && $err && \*STDERR != $err) { + open(STDERR, '>&', $err) + or warn "Can't redirect stderr\n"; + } + + my $setsid = $self->get_option($options, 'SETSID'); + setsid() if defined($setsid) && $setsid; + + $self->exec_command($options); + } + + debug2("Pipe (PID $pid, $pipe) created for: ", + join(" ", @{$options->{'COMMAND'}}), + "\n"); + + $options->{'PID'} = $pid; + + return $pipe; +} + +# Note, do not run with $user="root", and $chroot=0, because root +# access to the host system is not allowed by schroot, nor required +# via sudo. +sub run_command_internal { + my $self = shift; + my $options = shift; + + my $pid = fork(); + + if (!defined $pid) { + warn "Cannot fork: $!\n"; + } elsif ($pid == 0) { # child + + # redirect stdin + my $in = $self->get_option($options, 'STREAMIN'); + if (defined($in) && $in && \*STDIN != $in) { + open(STDIN, '<&', $in) + or warn "Can't redirect stdin\n"; + } + + # redirect stdout + my $out = $self->get_option($options, 'STREAMOUT'); + if (defined($out) && $out && \*STDOUT != $out) { + open(STDOUT, '>&', $out) + or warn "Can't redirect stdout\n"; + } + + # redirect stderr + my $err = $self->get_option($options, 'STREAMERR'); + if (defined($err) && $err && \*STDERR != $err) { + open(STDERR, '>&', $err) + or warn "Can't redirect stderr\n"; + } + + my $setsid = $self->get_option($options, 'SETSID'); + setsid() if defined($setsid) && $setsid; + + $self->exec_command($options); + } + + debug2("Pipe (PID $pid) created for: ", + join(" ", @{$options->{'COMMAND'}}), + "\n"); + + waitpid($pid, 0); +} + +# Note, do not run with $user="root", and $chroot=0, because root +# access to the host system is not allowed by schroot, nor required +# via sudo. +sub run_command { + my $self = shift; + my $options = shift; + + $options->{'INTCOMMAND'} = copy($options->{'COMMAND'}); + $options->{'INTCOMMAND_STR'} = copy($options->{'COMMAND_STR'}); + + return $self->run_command_internal($options); +} + +# Note, do not run with $user="root", and $chroot=0, because root +# access to the host system is not allowed by schroot, nor required +# via sudo. +sub pipe_command { + my $self = shift; + my $options = shift; + + $options->{'INTCOMMAND'} = copy($options->{'COMMAND'}); + $options->{'INTCOMMAND_STR'} = copy($options->{'COMMAND_STR'}); + + return $self->pipe_command_internal($options); +} + +sub get_internal_exec_string { + return; +} + +# This function must not print anything to standard output or standard error +# when it dies because its output will be treated as the output of the program +# it executes. So error handling can only happen with "die()". +sub exec_command { + my $self = shift; + my $options = shift; + + my @filter; + my $chrootfilter = $self->get('Defaults')->{'ENV_FILTER'}; + push(@filter, @{$chrootfilter}); + + my $commandfilter = $options->{'ENV_FILTER'}; + push(@filter, @{$commandfilter}) if defined($commandfilter); + + # Sanitise environment + foreach my $var (keys %ENV) { + my $match = 0; + foreach my $regex (@filter) { + $match = 1 if + $var =~ m/($regex)/; + } + delete $ENV{$var} if + $match == 0; + if (!$match) { + debug2("Environment filter: Deleted $var\n"); + } else { + debug2("Environment filter: Kept $var\n"); + } + } + + my $chrootenv = $self->get('Defaults')->{'ENV'}; + foreach (keys %$chrootenv) { + $ENV{$_} = $chrootenv->{$_}; + } + + my $commandenv = $options->{'ENV'}; + foreach (keys %$commandenv) { + $ENV{$_} = $commandenv->{$_}; + } + + # get_command_internal has to be called *after* $ENV was set because + # depending on the backend, environment variables have to be handled + # differently. For example the autopkgtest backend has to insert an + # explicit call to env into the command so that the environment variables + # survive. + $self->get_command_internal($options); + + if (!defined($options->{'EXPCOMMAND'}) || $options->{'EXPCOMMAND'} eq '' + || !defined($options->{'COMMAND'}) || scalar(@{$options->{'COMMAND'}}) == 0 + || !defined($options->{'INTCOMMAND'}) || scalar(@{$options->{'INTCOMMAND'}}) == 0) { + die "get_command_internal failed during exec_command\n"; + } + + $self->log_command($options); + + my $command = $options->{'EXPCOMMAND'}; + + my $program = $command->[0]; + $program = $options->{'PROGRAM'} if defined($options->{'PROGRAM'}); + + debug2("PROGRAM: $program\n"); + debug2("COMMAND: ", join(" ", @{$options->{'COMMAND'}}), "\n"); + debug2("COMMAND_STR: ", $options->{'COMMAND'} // 'UNDEFINED', "\n"); + debug2("INTCOMMAND: ", join(" ", @{$options->{'INTCOMMAND'}}), "\n"); + debug2("INTCOMMAND_STR: ", $options->{'INTCOMMAND_STR:'} // 'UNDEFINED', "\n"); + debug2("EXPCOMMAND: ", join(" ", @{$options->{'EXPCOMMAND'}}), "\n"); + + debug2("Environment set:\n"); + foreach (sort keys %ENV) { + debug2(' ' . $_ . '=' . ($ENV{$_} || '') . "\n"); + } + + debug("Running command: ", join(" ", @$command), "\n"); + exec { $program } @$command; + die "Failed to exec: $command->[0]: $!"; +} + +sub lock_chroot { + my $self = shift; + my $new_job = shift; + my $new_pid = shift; + my $new_user = shift; + + my $lockfile = '/var/lock/sbuild'; + my $max_trys = $self->get_conf('MAX_LOCK_TRYS'); + my $lock_interval = $self->get_conf('LOCK_INTERVAL'); + + # The following command in run /inside/ the chroot to create the lockfile. + my $command = <<"EOF"; + + use strict; + use warnings; + use POSIX; + use FileHandle; + + my \$lockfile="$lockfile"; + my \$try = 0; + + repeat: + if (!sysopen( F, \$lockfile, O_WRONLY|O_CREAT|O_TRUNC|O_EXCL, 0644 )){ + if (\$! == EEXIST) { + # lock file exists, wait + goto repeat if !open( F, "<\$lockfile" ); + my \$line = <F>; + my (\$job, \$pid, \$user); + close( F ); + if (\$line !~ /^(\\S+)\\s+(\\S+)\\s+(\\S+)/) { + print STDERR "Bad lock file contents (\$lockfile) -- still trying\\n"; + } else { + (\$job, \$pid, \$user) = (\$1, \$2, \$3); + if (kill( 0, \$pid ) == 0 && \$! == ESRCH) { + # process no longer exists, remove stale lock + print STDERR "Removing stale lock file \$lockfile ". + "(job \$job, pid \$pid, user \$user)\\n"; + if (!unlink(\$lockfile)) { + if (\$! != ENOENT) { + print STDERR "Cannot remove chroot lock file \$lockfile: \$!\\n"; + exit 1; + } + } + } + } + ++\$try; + if (\$try > $max_trys) { + print STDERR "Lockfile \$lockfile still present after " . + $max_trys * $lock_interval . " seconds -- giving up\\n"; + exit 1; + } + print STDERR "Another sbuild process (job \$job, pid \$pid by user \$user) is currently using the build chroot; waiting...\\n" + if \$try == 1; + sleep $lock_interval; + goto repeat; + } else { + print STDERR "Failed to create lock file \$lockfile: \$!\\n"; + exit 1; + } + } + + F->print("$new_job $new_pid $new_user\\n"); + F->close(); + + exit 0; +EOF + + $self->run_command( + { COMMAND => ['perl', + '-e', + $command], + USER => 'root', + PRIORITY => 0, + DIR => '/' }); + + if ($?) { + return 0; + } + return 1; +} + +sub unlock_chroot { + my $self = shift; + + my $lockfile = '/var/lock/sbuild'; + + # The following command in run /inside/ the chroot to remove the lockfile. + my $command = <<"EOF"; + + use strict; + use warnings; + use POSIX; + + my \$lockfile="$lockfile"; + if (!unlink(\$lockfile)) { + print STDERR "Cannot remove chroot lock file \$lockfile: \$!\\n" + if \$! != ENOENT; + exit 1; + } + exit 0; +EOF + + debug("Removing chroot lock file $lockfile\n"); + $self->run_command( + { COMMAND => ['perl', + '-e', + $command], + USER => 'root', + PRIORITY => 0, + DIR => '/' }); + + if ($?) { + return 0; + } + return 1; +} + +sub useradd { + my $self = shift; + my @args = @_; + $self->run_command( + { COMMAND => ['useradd', @args], + USER => 'root', + STREAMIN => $devnull, + STREAMOUT => $devnull, + DIR => '/' }); + if ($?) { + return 1; + } + return 0; +} + +sub groupadd { + my $self = shift; + my @args = @_; + $self->run_command( + { COMMAND => ['groupadd', @args], + USER => 'root', + STREAMIN => $devnull, + STREAMOUT => $devnull, + DIR => '/' }); + if ($?) { + return 1; + } + return 0; +} + +1; diff --git a/lib/Sbuild/ChrootAutopkgtest.pm b/lib/Sbuild/ChrootAutopkgtest.pm new file mode 100644 index 0000000..cea1c81 --- /dev/null +++ b/lib/Sbuild/ChrootAutopkgtest.pm @@ -0,0 +1,297 @@ +# +# Chroot.pm: chroot library for sbuild +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2005-2008 Roger Leigh <rleigh@debian.org> +# Copyright © 2008 Simon McVittie <smcv@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::ChrootAutopkgtest; + +use strict; +use warnings; + +use POSIX qw(setsid); +use Sbuild qw(shellescape); + +BEGIN { + use Exporter (); + use Sbuild::Chroot; + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::Chroot); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + my $chroot_id = shift; + + my $self = $class->SUPER::new($conf, $chroot_id); + bless($self, $class); + + $self->set('Autopkgtest Pipe In', undef); + $self->set('Autopkgtest Pipe Out', undef); + $self->set('Autopkgtest Virt PID', undef); + + return $self; +} + +sub begin_session { + my $self = shift; + + # We are manually setting up bidirectional communication with autopkgtest + # instead of using IPC::Open2 because we must call setsid() from the + # child. + # + # Calling setsid() is necessary to place autopkgtest into a new process + # group and thus prevent it from receiving for example a Ctrl+C that can be + # sent by the user from a terminal. If autopkgtest would receive the + # SIGINT, then it would close the session immediately without us being able + # to do anything about it. Instead, we want to close the session later + # ourselves. + pipe(my $prnt_out, my $chld_in); + pipe(my $chld_out, my $prnt_in); + + my $pid = fork(); + if (!defined $pid) { + die "Cannot fork: $!"; + } elsif ($pid == 0) { + # child + close($chld_in); + close($chld_out); + + # redirect stdin + open(STDIN, '<&', $prnt_out) + or die "Can't redirect stdin\n"; + + # redirect stdout + open(STDOUT, '>&', $prnt_in) + or die "Can't redirect stdout\n"; + + # put process into new group + setsid(); + + my @command = ($self->get_conf('AUTOPKGTEST_VIRT_SERVER'), + @{$self->get_conf('AUTOPKGTEST_VIRT_SERVER_OPTIONS')}); + exec { $self->get_conf('AUTOPKGTEST_VIRT_SERVER') } @command; + die "Failed to exec $self->get_conf('AUTOPKGTEST_VIRT_SERVER'): $!"; + } + close($prnt_out); + close($prnt_in); + + # We must enable autoflushing for the stdin of the child process or + # otherwise the commands we write will never reach the child. + $chld_in->autoflush(1); + + if (!$pid) { + print STDERR "Chroot setup failed\n"; + return 0; + } + + my $status = <$chld_out>; + + if (!defined $status) { + print STDERR "Undefined chroot status\n"; + return 0; + } + + chomp $status; + + if (! defined $status || $status ne "ok") { + print STDERR "autopkgtest-virt server returned unexpected value: $status\n"; + kill 'KILL', $pid; + return 0; + } + + print $chld_in "open\n"; + + $status = <$chld_out>; + + if (!defined $status) { + print STDERR "Undefined return value after 'open'\n"; + return 0; + } + + chomp $status; + + my $autopkgtest_session; + if ($status =~ /^ok (.*)$/) { + $autopkgtest_session = $1; + $self->set('Session ID', $autopkgtest_session); + } else { + print STDERR "autopkgtest-virt server: cannot open: $status\n"; + kill 'KILL', $pid; + return 0; + } + + print STDERR "Setting up chroot with session id $autopkgtest_session\n" + if $self->get_conf('DEBUG'); + + print $chld_in "capabilities\n"; + + chomp ($status = <$chld_out>); + + my @capabilities; + if ($status =~ /^ok (.*)$/) { + @capabilities = split /\s+/, $1; + } else { + print STDERR "autopkgtest-virt server: cannot capabilities: $status\n"; + kill 'KILL', $pid; + return 0; + } + + if (! grep {$_ eq "root-on-testbed"} @capabilities) { + print STDERR "autopkgtest-virt server: capability root-on-testbed missing\n"; + kill 'KILL', $pid; + return 0; + } + + # TODO: also test "revert" capability + + print $chld_in "print-execute-command\n"; + + chomp ($status = <$chld_out>); + + my $exec_cmd; + if ($status =~ /^ok (.*)$/) { + $exec_cmd = $1; + } else { + print STDERR "autopkgtest-virt server: cannot print-execute-command: $status\n"; + kill 'KILL', $pid; + return 0; + } + + my @exec_args = split /,/, $exec_cmd; + + @exec_args = map { s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; $_ } @exec_args; + + $self->set('Location', '/autopkgtest-virt-dummy-location'); + $self->set('Autopkgtest Pipe In', $chld_in); + $self->set('Autopkgtest Pipe Out', $chld_out); + $self->set('Autopkgtest Virt PID', $pid); + $self->set('Autopkgtest Exec Command', \@exec_args); + + return 0 if !$self->_setup_options(); + + return 1; +} + +sub end_session { + my $self = shift; + + return if $self->get('Session ID') eq ""; + + print STDERR "Cleaning up chroot (session id " . $self->get('Session ID') . ")\n" + if $self->get_conf('DEBUG'); + + my $chld_in = $self->get('Autopkgtest Pipe In'); + my $chld_out = $self->get('Autopkgtest Pipe Out'); + my $pid = $self->get('Autopkgtest Virt PID'); + + print $chld_in "close\n"; + + my $status = <$chld_out>; + + if (!defined $status) { + print STDERR "Undefined return value after 'close'\n"; + return 0; + } + + chomp $status; + + if ($status ne "ok") { + print STDERR "autopkgtest-virt server: cannot close: $status\n"; + return 0; + } + + print $chld_in "quit\n"; + + waitpid $pid, 0; + + if ($?) { + my $child_exit_status = $? >> 8; + print STDERR "autopkgtest-virt quit with exit status $child_exit_status\n"; + return 0; + } + + close($chld_in); + close($chld_out); + + $self->set('Autopkgtest Pipe In', undef); + $self->set('Autopkgtest Pipe Out', undef); + $self->set('Autopkgtest Virt PID', undef); + + return 1; +} + +sub get_command_internal { + my $self = shift; + my $options = shift; + + # Command to run. If I have a string, use it. Otherwise use the list-ref + my $command = $options->{'INTCOMMAND_STR'} // $options->{'INTCOMMAND'}; + + my $user = $options->{'USER'}; # User to run command under + my $dir; # Directory to use (optional) + $dir = $self->get('Defaults')->{'DIR'} if + (defined($self->get('Defaults')) && + defined($self->get('Defaults')->{'DIR'})); + $dir = $options->{'DIR'} if + defined($options->{'DIR'}) && $options->{'DIR'}; + + if (!defined $user || $user eq "") { + $user = $self->get_conf('USERNAME'); + } + + my @cmdline = (); + + @cmdline = @{$self->get('Autopkgtest Exec Command')}; + + push @cmdline, 'env'; + foreach my $var (keys %ENV) { + push @cmdline, "$var=$ENV{$var}"; + } + + if ($user ne "root") { + push @cmdline, "/sbin/runuser", '-u', $user, '--'; + } + + if (defined($dir)) { + my $shelldir = shellescape $dir; + push @cmdline, 'sh', '-c', "cd $shelldir && exec \"\$@\"", 'exec'; + } else { + $dir = '/'; + } + + if (ref $command) { + push @cmdline, @$command; + } else { + push @cmdline, ('/bin/sh', '-c', $command); + $command = [split(/\s+/, $command)]; + } + + $options->{'USER'} = $user; + $options->{'COMMAND'} = $command; + $options->{'EXPCOMMAND'} = \@cmdline; + $options->{'CHDIR'} = undef; + $options->{'DIR'} = $dir; +} + +1; diff --git a/lib/Sbuild/ChrootInfo.pm b/lib/Sbuild/ChrootInfo.pm new file mode 100644 index 0000000..30ef290 --- /dev/null +++ b/lib/Sbuild/ChrootInfo.pm @@ -0,0 +1,143 @@ +# +# ChrootInfo.pm: chroot utility library for sbuild +# Copyright © 2005-2008 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::ChrootInfo; + +use strict; +use warnings; + +use Sbuild::Base; + +use POSIX; +use FileHandle; +use File::Temp (); + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::Base); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + + my $self = $class->SUPER::new($conf); + bless($self, $class); + + $self->set('Chroots', {}); + + $self->get_info_all(); + + return $self; +} + + + +sub create { + my $self = shift; + my $namespace = shift; + my $distribution = shift; + my $chroot = shift; + my $arch = shift; # this is the build arch + + my $chrootid = $self->find($namespace, $distribution, $chroot, $arch); + + my $newchroot = $self->_create($chrootid); + + if (defined($newchroot)) { + $newchroot->set('Chroots', $self); + } + + return $newchroot; +} + + +sub find { + my $self = shift; + my $namespace = shift; + my $distribution = shift; + my $chroot = shift; + my $arch = shift; # this is the build arch + + # Use namespace given from $distribution if one is found + if ($distribution =~ /^([^:]+):/msx) { + $namespace = $1; + $distribution =~ s/^[^:]+://msx; + } + + my $chroots = $self->get('Chroots'); + + # Don't do strict arch checking if ARCH == HOST_ARCH. + if (!defined($arch) || $arch eq "") { + $arch = $self->get_conf('BUILD_ARCH'); + } + my $host_arch = $self->get_conf('HOST_ARCH'); + + if (!defined $chroot) { + my $ns = $chroots->{$namespace}; + if (!defined($ns)) { + if ($namespace ne 'chroot') { + $chroot = $self->find('chroot', $distribution, $chroot, $arch); + } else { + return undef; + } + } + + if ($arch ne $host_arch && + defined($ns->{"${distribution}-${arch}-${host_arch}-sbuild"})) { + $chroot = "${namespace}:${distribution}-${arch}-${host_arch}-sbuild"; + } + elsif ($arch ne $host_arch && + defined($ns->{"${distribution}-${arch}-${host_arch}"})) { + $chroot = "${namespace}:${distribution}-${arch}-${host_arch}"; + } + elsif ($arch ne "" && + defined($ns->{"${distribution}-${arch}-sbuild"})) { + $chroot = "${namespace}:${distribution}-${arch}-sbuild"; + } + elsif (defined($ns->{"${distribution}-sbuild"})) { + $chroot = "${namespace}:${distribution}-sbuild"; + } + elsif ($arch ne "" && + defined($ns->{"${distribution}-${arch}"})) { + $chroot = "${namespace}:${distribution}-${arch}"; + } elsif (defined($ns->{$distribution})) { + $chroot = "${namespace}:${distribution}"; + } + } + + if (!$chroot) { + # Fall back to chroot namespace. + if ($namespace ne 'chroot') { + $chroot = $self->find('chroot', $distribution, $chroot, $arch); + } else { + $self->log_error("Chroot for distribution $distribution, architecture $arch not found\n"); + return undef; + } + } + + return $chroot; +} + +1; diff --git a/lib/Sbuild/ChrootInfoAutopkgtest.pm b/lib/Sbuild/ChrootInfoAutopkgtest.pm new file mode 100644 index 0000000..e43c52a --- /dev/null +++ b/lib/Sbuild/ChrootInfoAutopkgtest.pm @@ -0,0 +1,67 @@ +# +# ChrootInfo.pm: chroot utility library for sbuild +# Copyright © 2005-2009 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::ChrootInfoAutopkgtest; + +use Sbuild::ChrootInfo; +use Sbuild::ChrootAutopkgtest; + +use strict; +use warnings; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::ChrootInfo); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + + my $self = $class->SUPER::new($conf); + bless($self, $class); + + return $self; +} + +sub get_info_all { + my $self = shift; + + my $chroots = {}; + + $self->set('Chroots', $chroots); +} + +sub _create { + my $self = shift; + my $chroot_id = shift; + + my $chroot = undef; + + $chroot = Sbuild::ChrootAutopkgtest->new($self->get('Config'), $chroot_id); + + return $chroot; +} + +1; diff --git a/lib/Sbuild/ChrootInfoSchroot.pm b/lib/Sbuild/ChrootInfoSchroot.pm new file mode 100644 index 0000000..92b4c03 --- /dev/null +++ b/lib/Sbuild/ChrootInfoSchroot.pm @@ -0,0 +1,186 @@ +# +# ChrootInfo.pm: chroot utility library for sbuild +# Copyright © 2005-2009 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::ChrootInfoSchroot; + +use Sbuild::ChrootInfo; +use Sbuild::ChrootSchroot; + +use strict; +use warnings; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::ChrootInfo); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + + my $self = $class->SUPER::new($conf); + bless($self, $class); + + return $self; +} + +sub get_info_from_stream { + my $self = shift; + my $stream = shift; + + my $chroot_type = ''; + my %tmp = ('Namespace' => '', + 'Name' => '', + 'Priority' => 0, + 'Location' => '', + 'Session Purged' => 0); + + while (<$stream>) { + chomp; + + last if ! $_; + + if (/^\s*(───|---) Chroot \1$/ && + $tmp{'Namespace'} eq "") { + $tmp{'Namespace'} = 'chroot'; + } + if (/^\s*(───|---) Session \1$/ && + $tmp{'Namespace'} eq "") { + $tmp{'Namespace'} = 'session'; + } + if (/^\s*(───|---) Source \1$/ && + $tmp{'Namespace'} eq "") { + $tmp{'Namespace'} = 'source'; + } + if (/^\s*Name:?\s+(.*)$/ && + $tmp{'Name'} eq "") { + $tmp{'Name'} = $1; + } + if (/^\s*Type:?\s+(.*)$/) { + $chroot_type = $1; + } + if (/^\s*Location:?\s+(.*)$/ && + $tmp{'Location'} eq "") { + $tmp{'Location'} = $1; + } + if (/^\s*Mount Location:?\s+(.*)$/ && + $tmp{'Location'} eq "") { + $tmp{'Location'} = $1; + } + # Path takes priority over Location and Mount Location. + if (/^\s*Path:?\s+(.*)$/) { + $tmp{'Location'} = $1; + } + if (/^\s*Priority:?\s+(\d+)$/) { + $tmp{'Priority'} = $1; + } + if (/^\s*Session Purged\s+(.*)$/) { + if ($1 eq "true") { + $tmp{'Session Purged'} = 1; + } + } + if (/^\s*Aliases:?\s+(.*)$/) { + $tmp{'Aliases'} = $1; + } + } + + if ($self->get_conf('DEBUG') && $tmp{'Name'}) { + print STDERR "Found schroot chroot: $tmp{'Namespace'}:$tmp{'Name'}\n"; + foreach (sort keys %tmp) { + print STDERR " $_ $tmp{$_}\n"; + } + } + + if (!$tmp{'Name'}) { + return undef; + } + return \%tmp; +} + +sub get_info { + my $self = shift; + my $chroot = shift; + + my $chroot_type = ""; + + # If namespaces aren't supported, try to fall back to old style session. + open CHROOT_DATA, '-|', $self->get_conf('SCHROOT'), '--info', '--chroot', "session:$chroot" or + open CHROOT_DATA, '-|', $self->get_conf('SCHROOT'), '--info', '--chroot', $chroot or + die 'Can\'t run ' . $self->get_conf('SCHROOT') . ' to get chroot data'; + + my $tmp = $self->get_info_from_stream(\*CHROOT_DATA); + + if (!$tmp) { + close CHROOT_DATA; + return undef; + } + + close CHROOT_DATA or die "Can't close schroot pipe getting chroot data"; + + return $tmp; +} + +sub get_info_all { + my $self = shift; + + my $chroots = {}; + + local %ENV; + + $ENV{'LC_ALL'} = 'C'; + $ENV{'LANGUAGE'} = 'C'; + + open CHROOTS, '-|', $self->get_conf('SCHROOT'), '--info' + or die 'Can\'t run ' . $self->get_conf('SCHROOT'); + my $tmp = undef; + while (defined($tmp = $self->get_info_from_stream(\*CHROOTS))) { + my $namespace = $tmp->{'Namespace'}; + $namespace = "chroot" + if !$tmp->{'Namespace'}; + $chroots->{$namespace} = {} + if (!exists($chroots->{$namespace})); + $chroots->{$namespace}->{$tmp->{'Name'}} = $tmp; + foreach my $alias (split(/\s+/, $tmp->{'Aliases'})) { + $chroots->{$namespace}->{$alias} = $tmp; + } + } + close CHROOTS or die "Can't close schroot pipe"; + + $self->set('Chroots', $chroots); +} + +sub _create { + my $self = shift; + my $chroot_id = shift; + + my $chroot = undef; + + if (defined($chroot_id)) { + $chroot = Sbuild::ChrootSchroot->new($self->get('Config'), $chroot_id); + } + + return $chroot; +} + +1; diff --git a/lib/Sbuild/ChrootInfoSudo.pm b/lib/Sbuild/ChrootInfoSudo.pm new file mode 100644 index 0000000..5e0d28f --- /dev/null +++ b/lib/Sbuild/ChrootInfoSudo.pm @@ -0,0 +1,120 @@ +# +# ChrootInfo.pm: chroot utility library for sbuild +# Copyright © 2005-2006 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::ChrootInfoSudo; + +use Sbuild::ChrootInfo; +use Sbuild::ChrootSudo; + +use strict; +use warnings; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::ChrootInfo); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + + my $self = $class->SUPER::new($conf); + bless($self, $class); + + return $self; +} + +sub get_info { + my $self = shift; + my $chroot = shift; + + $chroot =~ /(\S+):(\S+)/; + my ($namespace, $chrootname) = ($1, $2); + + my $info = undef; + + if (exists($self->get('Chroots')->{$namespace}) && + defined($self->get('Chroots')->{$namespace}) && + exists($self->get('Chroots')->{$namespace}->{$chrootname})) { + $info = $self->get('Chroots')->{$namespace}->{$chrootname} + } + + return $info; +} + +sub get_info_all { + my $self = shift; + + my $chroots = {}; + # All sudo chroots are in the chroot namespace. + my $namespace = "chroot"; + $chroots->{$namespace} = {}; + + my $build_dir = $self->get_conf('BUILD_DIR'); + + # TODO: Configure $build_dir as $sudo_chroot_dir + foreach (glob($self->get_conf('SBUILD_MODE') eq "user" ? + "/etc/sbuild/chroot/*" : + "$build_dir/chroot-*")) { + my %tmp = ('Priority' => 0, + 'Location' => $_, + 'Session Purged' => 0); + if (-d $tmp{'Location'}) { + my $name = $_; + if ($self->get_conf('SBUILD_MODE') eq "user") { + $name =~ s/^\/etc\/sbuild\/chroot\///; + } else { + $name =~ s/\Q${build_dir}\/chroot-\E//; + } + if ($self->get_conf('DEBUG')) { + print STDERR "Found chroot $name\n"; + foreach (sort keys %tmp) { + print STDERR " $_ $tmp{$_}\n"; + } + } + + $tmp{'Name'} = $name; + $tmp{'Namespace'} = $namespace; + + $chroots->{$namespace}->{$name} = \%tmp; + } + } + + $self->set('Chroots', $chroots); +} + +sub _create { + my $self = shift; + my $chroot_id = shift; + + my $chroot = undef; + + if (defined($chroot_id)) { + $chroot = Sbuild::ChrootSudo->new($self->get('Config'), $chroot_id); + } + + return $chroot; +} + +1; diff --git a/lib/Sbuild/ChrootInfoUnshare.pm b/lib/Sbuild/ChrootInfoUnshare.pm new file mode 100644 index 0000000..adb1a9a --- /dev/null +++ b/lib/Sbuild/ChrootInfoUnshare.pm @@ -0,0 +1,94 @@ +# +# ChrootInfoUnshare.pm: chroot utility library for sbuild +# Copyright © 2018 Johannes Schauer Marin Rodrigues <josch@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::ChrootInfoUnshare; + +use Sbuild::ChrootInfo; +use Sbuild::ChrootUnshare; + +use strict; +use warnings; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::ChrootInfo); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + + my $self = $class->SUPER::new($conf); + bless($self, $class); + + return $self; +} + +sub get_info_all { + my $self = shift; + + my $chroots = {}; + + my $xdg_cache_home = $self->get_conf('HOME') . "/.cache/sbuild"; + if (defined($ENV{'XDG_CACHE_HOME'})) { + $xdg_cache_home = $ENV{'XDG_CACHE_HOME'} . '/sbuild'; + } + + my $num_found = 0; + if (opendir my $dh, $xdg_cache_home) { + while (defined(my $file = readdir $dh)) { + next if $file eq '.' || $file eq '..'; + next if $file !~ /^[^-]+-[^-]+(-[^-]+)?(-sbuild)?\.t.+$/; + my $isdir = -d "$xdg_cache_home/$file"; + $file =~ s/\.t.+$//; # chop off extension + if (! $isdir) { + $chroots->{'chroot'}->{$file} = 1; + } + $chroots->{'source'}->{$file} = 1; + $num_found += 1; + } + closedir $dh; + } + + if ($num_found == 0) { + print STDERR "I: No tarballs found in $xdg_cache_home\n"; + } + + $self->set('Chroots', $chroots); +} + +sub _create { + my $self = shift; + my $chroot_id = shift; + + my $chroot = undef; + + if (defined($chroot_id)) { + $chroot = Sbuild::ChrootUnshare->new($self->get('Config'), $chroot_id); + } + + return $chroot; +} + +1; diff --git a/lib/Sbuild/ChrootPlain.pm b/lib/Sbuild/ChrootPlain.pm new file mode 100644 index 0000000..f293a12 --- /dev/null +++ b/lib/Sbuild/ChrootPlain.pm @@ -0,0 +1,150 @@ +# +# Chroot.pm: chroot library for sbuild +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2005-2006 Roger Leigh <rleigh@debian.org> +# Copyright © 2008 Simon McVittie <smcv@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::ChrootPlain; + +use strict; +use warnings; + +use Sbuild qw(shellescape); + +use POSIX; +use FileHandle; +use File::Temp (); + +use Sbuild::Sysconfig; + +BEGIN { + use Exporter (); + use Sbuild::Chroot; + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::Chroot); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + my $chroot_id = shift; + + my $self = $class->SUPER::new($conf, $chroot_id); + bless($self, $class); + + # Only run split, because plain makes no guarantee that networking + # works inside the chroot. + $self->set('Split', 1); + + return $self; +} + +sub begin_session { + my $self = shift; + + $self->set('Priority', 0); + $self->set('Location', $self->get('Chroot ID')); + $self->set('Session Purged', 0); + + return 0 if !defined $self->get('Chroot ID'); + + # only setup plain chroot if the directory is not the root of the host + if ($self->get('Location') ne '/') { + return 0 if !$self->_setup_options(); + } + + return 1; +} + +sub end_session { + my $self = shift; + + # No-op for sudo. + + return 1; +} + +sub get_command_internal { + my $self = shift; + my $options = shift; + + # Command to run. If I have a string, use it. Otherwise use the list-ref + my $command = $options->{'INTCOMMAND_STR'} // $options->{'INTCOMMAND'}; + + my $user = $options->{'USER'}; # User to run command under + my $dir; # Directory to use (optional) + $dir = $self->get('Defaults')->{'DIR'} if + (defined($self->get('Defaults')) && + defined($self->get('Defaults')->{'DIR'})); + $dir = $options->{'DIR'} if + defined($options->{'DIR'}) && $options->{'DIR'}; + + if (!defined $user || $user eq "") { + $user = $self->get_conf('USERNAME'); + } + + my @cmdline; + + if (!defined($dir)) { + $dir = '/'; + } + + my $need_chroot = 0; + $need_chroot = 1 + if ($self->get('Location') ne '/'); + + my $need_su = 0; + $need_su = 1 + if (($need_chroot && $user ne 'root') || + (!$need_chroot && $user ne $self->get_conf('USERNAME'))); + + push(@cmdline, $self->get_conf('SUDO')) + if (($need_chroot || $need_su) && $user ne 'root'); + push(@cmdline, '/usr/sbin/chroot', $self->get('Location')) + if ($need_chroot); + push(@cmdline, $self->get_conf('SU'), "$user", '-s') + if ($need_su); + + + if( ref $command ) { + my $shellcommand; + foreach (@$command) { + my $tmp = $_; + if ($shellcommand) { + $shellcommand .= " " . shellescape $tmp; + } else { + $shellcommand = shellescape $tmp; + } + } + push(@cmdline, '/bin/sh', '-c', "cd " . (shellescape $dir) . " && $shellcommand"); + } else { + push(@cmdline, '/bin/sh', '-c', "cd " . (shellescape $dir) . " && ( $command )"); + } + + $options->{'USER'} = $user; + $options->{'COMMAND'} = ref($command) ? $command : [split(/\s+/, $command)]; + $options->{'EXPCOMMAND'} = \@cmdline; + $options->{'CHDIR'} = undef; + $options->{'DIR'} = $dir; +} + +1; diff --git a/lib/Sbuild/ChrootRoot.pm b/lib/Sbuild/ChrootRoot.pm new file mode 100644 index 0000000..7f51572 --- /dev/null +++ b/lib/Sbuild/ChrootRoot.pm @@ -0,0 +1,53 @@ +# +# ChrootRoot.pm: Run commands on the root filesystem +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2005-2009 Roger Leigh <rleigh@debian.org> +# Copyright © 2008 Simon McVittie <smcv@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::ChrootRoot; + +use strict; +use warnings; + +use Sbuild::ChrootPlain; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::ChrootPlain); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + + my $self = $class->SUPER::new($conf, '/'); + bless($self, $class); + + # There's no difference between split and unsplit when running on + # the root filesystem. + $self->set('Split', 0); + + return $self; +} + +1; diff --git a/lib/Sbuild/ChrootSchroot.pm b/lib/Sbuild/ChrootSchroot.pm new file mode 100644 index 0000000..8c88284 --- /dev/null +++ b/lib/Sbuild/ChrootSchroot.pm @@ -0,0 +1,173 @@ +# +# Chroot.pm: chroot library for sbuild +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2005-2008 Roger Leigh <rleigh@debian.org> +# Copyright © 2008 Simon McVittie <smcv@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::ChrootSchroot; + +use strict; +use warnings; + +use Sbuild qw(shellescape); + +BEGIN { + use Exporter (); + use Sbuild::Chroot; + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::Chroot); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + my $chroot_id = shift; + + my $self = $class->SUPER::new($conf, $chroot_id); + bless($self, $class); + + return $self; +} + +sub begin_session { + my $self = shift; + my $chroot = $self->get('Chroot ID'); + + return 0 if !defined $chroot; + + # Don't use namespaces in compat mode. + if ($Sbuild::Sysconfig::compat_mode) { + $chroot =~ s/^[^:]+://msx; + } + + my $schroot_session=readpipe($self->get_conf('SCHROOT') . " -c $chroot --begin-session"); + chomp($schroot_session); + if ($?) { + print STDERR "Chroot setup failed\n"; + return 0; + } + + $self->set('Session ID', $schroot_session); + print STDERR "Setting up chroot $chroot (session id $schroot_session)\n" + if $self->get_conf('DEBUG'); + + my $info = $self->get('Chroots')->get_info($schroot_session); + if (defined($info) && + defined($info->{'Location'}) && -d $info->{'Location'}) { + $self->set('Priority', $info->{'Priority'}); + $self->set('Location', $info->{'Location'}); + $self->set('Session Purged', $info->{'Session Purged'}); + } else { + print STDERR $self->get('Chroot ID') . " chroot does not exist\n"; + return 0; + } + + return 0 if !$self->_setup_options(); + + return 1; +} + +sub end_session { + my $self = shift; + + return if $self->get('Session ID') eq ""; + + print STDERR "Cleaning up chroot (session id " . $self->get('Session ID') . ")\n" + if $self->get_conf('DEBUG'); + system($self->get_conf('SCHROOT'), '-c', $self->get('Session ID'), '--end-session'); + $self->set('Session ID', ""); + if ($?) { + print STDERR "Chroot cleanup failed\n"; + return 0; + } + + return 1; +} + +sub _get_exec_argv { + my $self = shift; + my $dir = shift; + my $user = shift; + + return ($self->get_conf('SCHROOT'), + '-d', $dir, + '-c', $self->get('Session ID'), + '--run-session', + @{$self->get_conf('SCHROOT_OPTIONS')}, + '-u', "$user", '-p', '--'); +} + +sub get_internal_exec_string { + my $self = shift; + + return if $self->get('Session ID') eq ""; + + return join " ", (map + { shellescape $_ } + $self->_get_exec_argv('/', 'root')); +} + +sub get_command_internal { + my $self = shift; + my $options = shift; + + return if $self->get('Session ID') eq ""; + + if (defined($options->{'DISABLE_NETWORK'}) && $options->{'DISABLE_NETWORK'}) { + print STDERR "Disabling the network for this command was requested but the schroot backend doesn't support this feature yet: https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=802849\n" if $self->get_conf('DEBUG'); + } + + # Command to run. If I have a string, use it. Otherwise use the list-ref + my $command = $options->{'INTCOMMAND_STR'} // $options->{'INTCOMMAND'}; + + my $user = $options->{'USER'}; # User to run command under + my $dir; # Directory to use (optional) + $dir = $self->get('Defaults')->{'DIR'} if + (defined($self->get('Defaults')) && + defined($self->get('Defaults')->{'DIR'})); + $dir = $options->{'DIR'} if + defined($options->{'DIR'}) && $options->{'DIR'}; + + if (!defined $user || $user eq "") { + $user = $self->get_conf('USERNAME'); + } + + if (!defined($dir)) { + $dir = '/'; + } + + my @cmdline = $self->_get_exec_argv($dir, $user); + + if (ref $command) { + push @cmdline, @$command; + } else { + push @cmdline, ('/bin/sh', '-c', $command); + $command = [split(/\s+/, $command)]; + } + $options->{'USER'} = $user; + $options->{'COMMAND'} = $command; + $options->{'EXPCOMMAND'} = \@cmdline; + $options->{'CHDIR'} = undef; + $options->{'DIR'} = $dir; +} + +1; diff --git a/lib/Sbuild/ChrootSetup.pm b/lib/Sbuild/ChrootSetup.pm new file mode 100644 index 0000000..223f273 --- /dev/null +++ b/lib/Sbuild/ChrootSetup.pm @@ -0,0 +1,252 @@ +# +# ChrootSetup.pm: chroot maintenance operations +# Copyright © 2005-2009 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::ChrootSetup; + +use strict; +use warnings; + +use File::Temp qw(tempfile); +use Sbuild qw($devnull shellescape); + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter); + + @EXPORT = qw(basesetup shell hold_packages unhold_packages + list_packages set_package_status); +} + +sub basesetup ($$); +sub shell ($$); +sub hold_packages ($$@); +sub unhold_packages ($$@); +sub list_packages ($$@); +sub set_package_status ($$$@); + +sub basesetup ($$) { + my $session = shift; + my $conf = shift; + + # Add sbuild group + $session->run_command( + { COMMAND => ['getent', 'group', 'sbuild'], + USER => 'root', + STREAMIN => $devnull, + STREAMOUT => $devnull, + DIR => '/' }); + if ($?) { + # This will require root privileges. However, this should + # only get run at initial chroot setup time. + if ($session->groupadd("--system", "sbuild")) { + print STDERR "E: Failed to create group sbuild\n"; + return $? + } + } + + # Add users + foreach my $user ('sbuild', $session->get_conf('BUILD_USER')) { + $session->run_command( + { COMMAND => ['getent', 'passwd', $user], + USER => 'root', + STREAMIN => $devnull, + STREAMOUT => $devnull, + DIR => '/' }); + if ($?) { + # This will require root privileges. However, this should + # only get run at initial chroot setup time. + if ($session->useradd("--system", + '--home-dir', '/var/lib/sbuild', '--no-create-home', + '--shell', '/bin/bash', '--gid', 'sbuild', + '--comment', 'Debian source builder,,,', $user)) { + print STDERR "E: Failed to create user $user\n"; + return $? + } + } + } + + my $build_path = '/build'; + if (defined($session->get_conf('BUILD_PATH')) && $session->get_conf('BUILD_PATH')) { + $build_path = $session->get_conf('BUILD_PATH'); + } + + $session->run_command( + { COMMAND => ['/bin/sh', '-c', + 'set -e; if [ ! -d ' . (shellescape $build_path) . ' ] ; then mkdir -p -m 0775 ' . (shellescape $build_path) . '; fi'], + USER => 'root', + DIR => '/' }); + if ($?) { + print STDERR "E: Failed to create build directory $build_path\n"; + return $? + } + + $session->run_command( + { COMMAND => ['chown', 'sbuild:sbuild', $build_path], + USER => 'root', + DIR => '/' }); + if ($?) { + print STDERR "E: Failed to set sbuild:sbuild ownership on $build_path\n"; + return $? + } + + $session->run_command( + { COMMAND => ['chmod', '02770', $build_path], + USER => 'root', + DIR => '/' }); + if ($?) { + print STDERR "E: Failed to set 0750 permissions on $build_path\n"; + return $? + } + + $session->run_command( + { COMMAND => ['/bin/sh', '-c', + 'set -e; if [ ! -d /var/lib/sbuild ] ; then mkdir -m 2775 /var/lib/sbuild; fi'], + USER => 'root', + DIR => '/' }); + if ($?) { + print STDERR "E: Failed to create build directory /var/lib/sbuild\n"; + return $? + } + + $session->run_command( + { COMMAND => ['/bin/sh', '-c', + 'set -e; if [ ! -d /var/lib/sbuild/srcdep-lock ] ; then mkdir -m 2770 /var/lib/sbuild/srcdep-lock; fi'], + USER => 'root', + DIR => '/' }); + if ($?) { + print STDERR "E: Failed to create sbuild directory /var/lib/sbuild/srcdep-lock\n"; + return $? + } + + $session->run_command( + { COMMAND => ['chown', '-R', 'sbuild:sbuild', '/var/lib/sbuild'], + USER => 'root', + DIR => '/' }); + if ($?) { + print STDERR "E: Failed to set sbuild:sbuild ownership on /var/lib/sbuild/\n"; + return $? + } + + $session->run_command( + { COMMAND => ['chmod', '02775', '/var/lib/sbuild'], + USER => 'root', + DIR => '/' }); + if ($?) { + print STDERR "E: Failed to set 02775 permissions on /var/lib/sbuild/\n"; + return $? + } + + # Set up debconf selections. + my $pipe = $session->pipe_command( + { COMMAND => ['/usr/bin/debconf-set-selections'], + PIPE => 'out', + USER => 'root', + PRIORITY => 0, + DIR => '/' }); + + if (!$pipe) { + warn "Cannot open pipe: $!\n"; + } else { + foreach my $selection ('man-db man-db/auto-update boolean false') { + print $pipe "$selection\n"; + } + close($pipe); + if ($?) { + print STDERR "E: debconf-set-selections failed\n"; + return $? + } + } + + return 0; +} + +sub shell ($$) { + my $session = shift; + my $conf = shift; + + $session->run_command( + { COMMAND => ['/bin/sh'], + PRIORITY => 1, + USER => $conf->get('BUILD_USER'), + STREAMIN => \*STDIN, + STREAMOUT => \*STDOUT, + STREAMERR => \*STDERR }); + return $? +} + +sub hold_packages ($$@) { + my $session = shift; + my $conf = shift; + + my $status = set_package_status($session, $conf, "hold", @_); + + return $status; +} + +sub unhold_packages ($$@) { + my $session = shift; + my $conf = shift; + + my $status = set_package_status($session, $conf, "install", @_); + + return $status; +} + +sub list_packages ($$@) { + my $session = shift; + my $conf = shift; + + $session->run_command( + {COMMAND => ['dpkg', '--list', @_], + USER => 'root', + PRIORITY => 0}); + return $?; +} + +sub set_package_status ($$$@) { + my $session = shift; + my $conf = shift; + my $status = shift; + + my $pipe = $session->pipe_command( + {COMMAND => ['dpkg', '--set-selections'], + PIPE => 'out', + USER => 'root', + PRIORITY => 0}); + + if (!$pipe) { + print STDERR "Can't run dpkg --set-selections in chroot\n"; + return 1; + } + + foreach (@_) { + print $pipe "$_ $status\n"; + } + + if (!close $pipe) { + print STDERR "Can't run dpkg --set-selections in chroot\n"; + } + + return $?; +} + +1; diff --git a/lib/Sbuild/ChrootSudo.pm b/lib/Sbuild/ChrootSudo.pm new file mode 100644 index 0000000..e258fd0 --- /dev/null +++ b/lib/Sbuild/ChrootSudo.pm @@ -0,0 +1,137 @@ +# +# Chroot.pm: chroot library for sbuild +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2005-2008 Roger Leigh <rleigh@debian.org> +# Copyright © 2008 Simon McVittie <smcv@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::ChrootSudo; + +use strict; +use warnings; + +use Sbuild qw(shellescape); +use Sbuild::Sysconfig; + +BEGIN { + use Exporter (); + use Sbuild::Chroot; + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::Chroot); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + my $chroot_id = shift; + + my $self = $class->SUPER::new($conf, $chroot_id); + bless($self, $class); + + return $self; +} + +sub begin_session { + my $self = shift; + my $chroot = $self->get('Chroot ID'); + + return 0 if !defined $chroot; + + my $info = $self->get('Chroots')->get_info($chroot); + + print STDERR "Setting up chroot $chroot\n" + if $self->get_conf('DEBUG'); + + if (defined($info) && + defined($info->{'Location'}) && -d $info->{'Location'}) { + $self->set('Priority', $info->{'Priority'}); + $self->set('Location', $info->{'Location'}); + $self->set('Session Purged', $info->{'Session Purged'}); + } else { + die $self->get('Chroot ID') . " chroot does not exist\n"; + } + + if ($self->get('Location') ne '/') { + return 0 if !$self->_setup_options(); + } + + return 1; +} + +sub end_session { + my $self = shift; + + # No-op for sudo. + + return 1; +} + +sub get_command_internal { + my $self = shift; + my $options = shift; + + # Command to run. If I have a string, use it. Otherwise use the list-ref + my $command = $options->{'INTCOMMAND_STR'} // $options->{'INTCOMMAND'}; + + my $user = $options->{'USER'}; # User to run command under + my $dir; # Directory to use (optional) + $dir = $self->get('Defaults')->{'DIR'} if + (defined($self->get('Defaults')) && + defined($self->get('Defaults')->{'DIR'})); + $dir = $options->{'DIR'} if + defined($options->{'DIR'}) && $options->{'DIR'}; + + if (!defined $user || $user eq "") { + $user = $self->get_conf('USERNAME'); + } + + my @cmdline; + + if (!defined($dir)) { + $dir = '/'; + } + + @cmdline = ($self->get_conf('SUDO'), '/usr/sbin/chroot', $self->get('Location'), + $self->get_conf('SU'), "$user", '-s'); + + if( ref $command ) { + my $shellcommand; + foreach (@$command) { + my $tmp = $_; + if ($shellcommand) { + $shellcommand .= " " . shellescape $tmp; + } else { + $shellcommand = shellescape $tmp; + } + } + push(@cmdline, '/bin/sh', '-c', "cd " . (shellescape $dir) . " && $shellcommand"); + } else { + push(@cmdline, '/bin/sh', '-c', "cd " . (shellescape $dir) . " && ( $command )"); + } + + $options->{'USER'} = $user; + $options->{'COMMAND'} = ref($command) ? $command : [split(/\s+/, $command)]; + $options->{'EXPCOMMAND'} = \@cmdline; + $options->{'CHDIR'} = undef; + $options->{'DIR'} = $dir; +} + +1; diff --git a/lib/Sbuild/ChrootUnshare.pm b/lib/Sbuild/ChrootUnshare.pm new file mode 100644 index 0000000..91a7fa4 --- /dev/null +++ b/lib/Sbuild/ChrootUnshare.pm @@ -0,0 +1,398 @@ +# +# ChrootUnshare.pm: chroot library for sbuild +# Copyright © 2018 Johannes Schauer Marin Rodrigues <josch@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::ChrootUnshare; + +use strict; +use warnings; + +use English; +use Sbuild::Utility; +use File::Temp qw(mkdtemp tempfile); +use File::Copy; +use Cwd qw(abs_path); +use Sbuild qw(shellescape); + +BEGIN { + use Exporter (); + use Sbuild::Chroot; + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::Chroot); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + my $chroot_id = shift; + + my $self = $class->SUPER::new($conf, $chroot_id); + bless($self, $class); + + return $self; +} + +sub begin_session { + my $self = shift; + my $chroot = $self->get('Chroot ID'); + + return 0 if !defined $chroot; + + my $namespace = undef; + if ($chroot =~ m/^(chroot|source):(.+)$/) { + $namespace = $1; + $chroot = $2; + } + + my $tarball = undef; + if ($chroot =~ '/') { + if (! -e $chroot) { + print STDERR "Chroot $chroot does not exist\n"; + return 0; + } + $tarball = abs_path($chroot); + } else { + my $xdg_cache_home = $self->get_conf('HOME') . "/.cache/sbuild"; + if (defined($ENV{'XDG_CACHE_HOME'})) { + $xdg_cache_home = $ENV{'XDG_CACHE_HOME'} . '/sbuild'; + } + + if (opendir my $dh, $xdg_cache_home) { + while (defined(my $file = readdir $dh)) { + next if $file eq '.' || $file eq '..'; + my $path = "$xdg_cache_home/$file"; + # FIXME: support directory chroots + #if (-d $path) { + # if ($file eq $chroot) { + # $tarball = $path; + # last; + # } + #} else { + if ($file =~ /^$chroot\.t.+$/) { + $tarball = $path; + last; + } + #} + } + closedir $dh; + } + + if (!defined($tarball)) { + print STDERR "Unable to find $chroot in $xdg_cache_home\n"; + return 0; + } + } + + my @idmap = read_subuid_subgid; + + # sanity check + if ( scalar(@idmap) != 2 + || $idmap[0][0] ne 'u' + || $idmap[1][0] ne 'g' + || length $idmap[0][1] == 0 + || length $idmap[0][2] == 0 + || length $idmap[1][1] == 0 + || length $idmap[1][2] == 0) + { + printf STDERR "invalid idmap\n"; + return 0; + } + + $self->set('Uid Gid Map', \@idmap); + + my @cmd; + my $exit; + + if(!test_unshare) { + print STDERR "E: unable to to unshare\n"; + return 0; + } + + my @unshare_cmd = get_unshare_cmd({IDMAP => \@idmap}); + + my $rootdir = mkdtemp($self->get_conf('UNSHARE_TMPDIR_TEMPLATE')); + + # $REAL_GROUP_ID is a space separated list of all groups the current user + # is in with the first group being the result of getgid(). We reduce the + # list to the first group by forcing it to be numeric + my $outer_gid = $REAL_GROUP_ID+0; + @cmd = (get_unshare_cmd({ + IDMAP => [['u', '0', $REAL_USER_ID, '1'], + ['g', '0', $outer_gid, '1'], + ['u', '1', $idmap[0][2], '1'], + ['g', '1', $idmap[1][2], '1'], + ] + }), 'chown', '1:1', $rootdir); + if ($self->get_conf('DEBUG')) { + printf STDERR "running @cmd\n"; + } + system(@cmd); + $exit = $? >> 8; + if ($exit) { + print STDERR "bad exit status ($exit): @cmd\n"; + return 0; + } + + if (! -e $tarball) { + print STDERR "$tarball does not exist, check \$unshare_tarball config option\n"; + return 0; + } + + # The tarball might be in a location where it cannot be accessed by the + # user from within the unshared namespace + if (! -r $tarball) { + print STDERR "$tarball is not readable\n"; + return 0; + } + + print STDOUT "Unpacking $tarball to $rootdir...\n"; + @cmd = (@unshare_cmd, 'tar', + '--exclude=./dev/urandom', + '--exclude=./dev/random', + '--exclude=./dev/full', + '--exclude=./dev/null', + '--exclude=./dev/console', + '--exclude=./dev/zero', + '--exclude=./dev/tty', + '--exclude=./dev/ptmx', + '--directory', $rootdir, + '--extract' + ); + push @cmd, get_tar_compress_options($tarball); + + if ($self->get_conf('DEBUG')) { + printf STDERR "running @cmd\n"; + } + my $pid = open(my $out, '|-', @cmd); + if (!defined($pid)) { + print STDERR "Can't fork: $!\n"; + return 0; + } + if (copy($tarball, $out) != 1) { + print STDERR "copy() failed: $!\n"; + return 0; + } + close($out); + $exit = $? >> 8; + if ($exit) { + print STDERR "bad exit status ($exit): @cmd\n"; + return 0; + } + + $self->set('Session ID', $rootdir); + + $self->set('Location', '/sbuild-unshare-dummy-location'); + + $self->set('Session Purged', 1); + + # if a source type chroot was requested, then we need to memorize the + # tarball location for when the session is ended + if (defined($namespace) && $namespace eq "source") { + $self->set('Tarball', $tarball); + } + + return 0 if !$self->_setup_options(); + + return 1; +} + +sub end_session { + my $self = shift; + + return if $self->get('Session ID') eq ""; + + if (defined($self->get('Tarball'))) { + my ($tmpfh, $tmpfile) = tempfile("XXXXXX"); + my @program_list = ("/bin/tar", "-c", "-C", $self->get('Session ID')); + push @program_list, get_tar_compress_options($self->get('Tarball')); + push @program_list, './'; + + print "I: Creating tarball...\n"; + open(my $in, '-|', get_unshare_cmd( + {IDMAP => $self->get('Uid Gid Map')}), @program_list + ) // die "could not exec tar"; + if (copy($in, $tmpfile) != 1 ) { + die "unable to copy: $!\n"; + } + close($in) or die "Could not create chroot tarball: $?\n"; + + move("$tmpfile", $self->get('Tarball')); + chmod 0644, $self->get('Tarball'); + + print "I: Done creating " . $self->get('Tarball') . "\n"; + } + + print STDERR "Cleaning up chroot (session id " . $self->get('Session ID') . ")\n" + if $self->get_conf('DEBUG'); + + # this looks like a recipe for disaster, but since we execute "rm -rf" with + # lxc-usernsexec, we only have permission to delete the files that were + # created with the fake root user + my @cmd = (get_unshare_cmd({IDMAP => $self->get('Uid Gid Map')}), 'rm', '-rf', $self->get('Session ID')); + if ($self->get_conf('DEBUG')) { + printf STDERR "running @cmd\n"; + } + system(@cmd); + # we ignore the exit status, because the command will fail to remove the + # unpack directory itself because of insufficient permissions + + if(-d $self->get('Session ID') && !rmdir($self->get('Session ID'))) { + print STDERR "unable to remove " . $self->get('Session ID') . ": $!\n"; + $self->set('Session ID', ""); + return 0; + } + + $self->set('Session ID', ""); + + return 1; +} + +sub _get_exec_argv { + my $self = shift; + my $dir = shift; + my $user = shift; + my $disable_network = shift // 0; + + # On systems with libnss-resolve installed there is no need for a + # /etc/resolv.conf. This works around this by adding 127.0.0.53 (default + # for systemd-resolved) in that case. + my $network_setup = '[ -f /etc/resolv.conf ] && cat /etc/resolv.conf > "$rootdir/etc/resolv.conf" || echo "nameserver 127.0.0.53" > "$rootdir/etc/resolv.conf";'; + my $unshare = CLONE_NEWNS | CLONE_NEWPID | CLONE_NEWUTS | CLONE_NEWIPC; + if ($disable_network) { + $unshare |= CLONE_NEWNET; + $network_setup = 'ip link set lo up;> "$rootdir/etc/resolv.conf";'; + } + + my @bind_mounts = (); + for my $entry (@{$self->get_conf('UNSHARE_BIND_MOUNTS')}) { + push @bind_mounts, $entry->{directory}, $entry->{mountpoint}; + } + + return ( + 'env', 'PATH=' . $self->get_conf('PATH'), + get_unshare_cmd({UNSHARE_FLAGS => $unshare, FORK => 1, IDMAP => $self->get('Uid Gid Map')}), 'sh', '-c', " + rootdir=\"\$1\"; shift; + user=\"\$1\"; shift; + dir=\"\$1\"; shift; + while [ \$# -gt 0 ]; do + if [ \"\$1\" = \"--\" ]; then shift; break; fi; + mkdir -p \"\$rootdir\$2\"; + mount -o rbind \"\$1\" \"\$rootdir\$2\"; + shift; shift; + done; + hostname sbuild; + echo \"127.0.0.1 localhost\\n127.0.1.1 sbuild\" > \"\$rootdir/etc/hosts\"; + $network_setup + mkdir -p \"\$rootdir/dev\"; + for f in null zero full random urandom tty console; do + touch \"\$rootdir/dev/\$f\"; + chmod -rwx \"\$rootdir/dev/\$f\"; + mount -o bind \"/dev/\$f\" \"\$rootdir/dev/\$f\"; + done; + ln -sfT /proc/self/fd \"\$rootdir/dev/fd\"; + ln -sfT /proc/self/fd/0 \"\$rootdir/dev/stdin\"; + ln -sfT /proc/self/fd/1 \"\$rootdir/dev/stdout\"; + ln -sfT /proc/self/fd/2 \"\$rootdir/dev/stderr\"; + mkdir -p \"\$rootdir/dev/pts\"; + mount -o noexec,nosuid,gid=5,mode=620,ptmxmode=666 -t devpts none \"\$rootdir/dev/pts\"; + ln -sfT /dev/pts/ptmx \"\$rootdir/dev/ptmx\"; + mkdir -p \"\$rootdir/dev/shm\"; + mount -t tmpfs tmpfs \"\$rootdir/dev/shm\"; + mkdir -p \"\$rootdir/sys\"; + mount -o rbind /sys \"\$rootdir/sys\"; + mkdir -p \"\$rootdir/proc\"; + mount -t proc proc \"\$rootdir/proc\"; + exec /usr/sbin/chroot \"\$rootdir\" /sbin/runuser -u \"\$user\" -- sh -c \"cd \\\"\\\$1\\\" && shift && \\\"\\\$@\\\"\" -- \"\$dir\" \"\$@\"; + ", '--', $self->get('Session ID'), $user, $dir, @bind_mounts, '--' + ); +} + +sub get_internal_exec_string { + my $self = shift; + + return join " ", (map + { shellescape $_ } + $self->_get_exec_argv('/', 'root')); +} + +sub get_command_internal { + my $self = shift; + my $options = shift; + + # Command to run. If I have a string, use it. Otherwise use the list-ref + my $command = $options->{'INTCOMMAND_STR'} // $options->{'INTCOMMAND'}; + + my $user = $options->{'USER'}; # User to run command under + my $dir; # Directory to use (optional) + $dir = $self->get('Defaults')->{'DIR'} if + (defined($self->get('Defaults')) && + defined($self->get('Defaults')->{'DIR'})); + $dir = $options->{'DIR'} if + defined($options->{'DIR'}) && $options->{'DIR'}; + + if (!defined $user || $user eq "") { + $user = $self->get_conf('USERNAME'); + } + + if (!defined($dir)) { + $dir = '/'; + } + + my $disable_network = 0; + if (defined($options->{'DISABLE_NETWORK'}) && $options->{'DISABLE_NETWORK'}) { + $disable_network = 1; + } + + my @cmdline = $self->_get_exec_argv($dir, $user, $disable_network); + if (ref $command) { + push @cmdline, @$command; + } else { + push @cmdline, ('/bin/sh', '-c', $command); + $command = [split(/\s+/, $command)]; + } + $options->{'USER'} = $user; + $options->{'COMMAND'} = $command; + $options->{'EXPCOMMAND'} = \@cmdline; + $options->{'CHDIR'} = undef; + $options->{'DIR'} = $dir; +} + +# create users from outside the chroot so we don't need user/groupadd inside. +sub useradd { + my $self = shift; + my @args = @_; + my $rootdir = $self->get('Session ID'); + my @idmap = read_subuid_subgid; + my @unshare_cmd = get_unshare_cmd({IDMAP => \@idmap}); + return system(@unshare_cmd, "/usr/sbin/useradd", "--root", $rootdir, @args); +} + +sub groupadd { + my $self = shift; + my @args = @_; + my $rootdir = $self->get('Session ID'); + my @idmap = read_subuid_subgid; + my @unshare_cmd = get_unshare_cmd({IDMAP => \@idmap}); + return system(@unshare_cmd, "/usr/sbin/groupadd", "--root", $rootdir, @args); +} + +1; diff --git a/lib/Sbuild/Conf.pm b/lib/Sbuild/Conf.pm new file mode 100644 index 0000000..77e3db3 --- /dev/null +++ b/lib/Sbuild/Conf.pm @@ -0,0 +1,1582 @@ +# +# Conf.pm: configuration library for sbuild +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2006-2010 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::Conf; + +use strict; +use warnings; + +use Cwd qw(cwd); +use File::Spec; +use POSIX qw(getgroups getgid); +use Sbuild qw(isin); +use Sbuild::ConfBase; +use Sbuild::Sysconfig; +use Dpkg::Build::Info; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter); + + @EXPORT = qw(new setup read); +} + +sub setup ($); +sub read ($); + +sub new { + my $conf = Sbuild::ConfBase->new(@_); + Sbuild::Conf::setup($conf); + Sbuild::Conf::read($conf); + + return $conf; +} + +sub setup ($) { + my $conf = shift; + + my $validate_program = sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + my $program = $conf->get($key); + + die "$key binary is not defined" + if !defined($program) || !$program; + + # Emulate execvp behaviour by searching the binary in the PATH. + my @paths = split(/:/, $conf->get('PATH')); + # Also consider the empty path for absolute locations. + push (@paths, ''); + my $found = 0; + foreach my $path (@paths) { + $found = 1 if (-x File::Spec->catfile($path, $program)); + } + + die "$key binary '$program' does not exist or is not executable" + if !$found; + }; + + my $validate_directory = sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + my $directory = $conf->get($key); + + die "$key directory is not defined" + if !defined($directory) || !$directory; + + die "$key directory '$directory' does not exist" + if !-d $directory; + }; + + my $validate_append_version = sub { + my $conf = shift; + my $entry = shift; + + if (defined($conf->get('APPEND_TO_VERSION')) && + $conf->get('APPEND_TO_VERSION') && + $conf->get('BUILD_SOURCE') != 0) { + # See <http://bugs.debian.org/475777> for details + die "The --append-to-version option is incompatible with a source upload\n"; + } + + if ($conf->get('BUILD_SOURCE') && + $conf->get('BIN_NMU')) { + print STDERR "Not building source package for binNMU\n"; + $conf->_set_value('BUILD_SOURCE', 0); + } + }; + + my $set_signing_option = sub { + my $conf = shift; + my $entry = shift; + my $value = shift; + my $key = $entry->{'NAME'}; + $conf->_set_value($key, $value); + + my @signing_options = (); + push @signing_options, "-m".$conf->get('MAINTAINER_NAME') + if defined $conf->get('MAINTAINER_NAME'); + push @signing_options, "-e".$conf->get('UPLOADER_NAME') + if defined $conf->get('UPLOADER_NAME'); + $conf->set('SIGNING_OPTIONS', \@signing_options); + }; + + our $HOME = $conf->get('HOME'); + + my %sbuild_keys = ( + 'CHROOT' => { + TYPE => 'STRING', + VARNAME => 'chroot', + GROUP => 'Chroot options', + DEFAULT => undef, + HELP => 'Default chroot (defaults to distribution[-arch][-sbuild])', + CLI_OPTIONS => ['-c', '--chroot'] + }, + 'BUILD_ARCH_ALL' => { + TYPE => 'BOOL', + VARNAME => 'build_arch_all', + GROUP => 'Build options', + DEFAULT => undef, + GET => sub { + my $conf = shift; + my $entry = shift; + + my $retval = $conf->_get($entry->{'NAME'}); + + if (!defined($retval)) { + if ($conf->get('BUILD_ARCH') ne $conf->get('HOST_ARCH')) { + # default for cross + $retval = 0; + } else { + # default for native + $retval = 1; + } + } + + return $retval; + }, + HELP => 'Build architecture: all packages by default.', + CLI_OPTIONS => ['--arch-all', '--no-arch-all'] + }, + 'BUILD_ARCH_ANY' => { + TYPE => 'BOOL', + VARNAME => 'build_arch_any', + GROUP => 'Build options', + DEFAULT => 1, + HELP => 'Build architecture: any packages by default.', + CLI_OPTIONS => ['--arch-any', '--no-arch-any'] + }, + 'BUILD_PROFILES' => { + TYPE => 'STRING', + VARNAME => 'build_profiles', + GROUP => 'Build options', + DEFAULT => undef, + GET => sub { + my $conf = shift; + my $entry = shift; + + my $retval = $conf->_get($entry->{'NAME'}); + + if (!defined($retval)) { + if ($conf->get('BUILD_ARCH') ne $conf->get('HOST_ARCH')) { + # default for cross + $retval = $ENV{'DEB_BUILD_PROFILES'} || 'cross nocheck'; + } else { + # default for native + $retval = $ENV{'DEB_BUILD_PROFILES'} || ''; + } + } + + return $retval; + }, + HELP => 'Build profiles. Separated by spaces. Defaults to the value of the DEB_BUILD_PROFILES environment variable when building natively and to the cross and nocheck profiles when cross-building.', + CLI_OPTIONS => ['--profiles'] + }, + 'NOLOG' => { + TYPE => 'BOOL', + VARNAME => 'nolog', + GROUP => 'Logging options', + DEFAULT => 0, + HELP => 'Disable use of log file', + CLI_OPTIONS => ['-n', '--nolog'] + }, + 'SUDO' => { + TYPE => 'STRING', + VARNAME => 'sudo', + GROUP => 'Programs', + CHECK => sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + + # Only validate if needed. + if ($conf->get('CHROOT_MODE') eq 'split' || + ($conf->get('CHROOT_MODE') eq 'schroot' && + $conf->get('CHROOT_SPLIT'))) { + $validate_program->($conf, $entry); + + local (%ENV) = %ENV; # make local environment + $ENV{'DEBIAN_FRONTEND'} = "noninteractive"; + $ENV{'APT_CONFIG'} = "test_apt_config"; + $ENV{'SHELL'} = '/bin/sh'; + + my $sudo = $conf->get('SUDO'); + chomp( my $test_df = `$sudo sh -c 'echo \$DEBIAN_FRONTEND'` ); + chomp( my $test_ac = `$sudo sh -c 'echo \$APT_CONFIG'` ); + chomp( my $test_sh = `$sudo sh -c 'echo \$SHELL'` ); + + if ($test_df ne "noninteractive" || + $test_ac ne "test_apt_config" || + $test_sh ne '/bin/sh') { + print STDERR "$sudo is stripping APT_CONFIG, DEBIAN_FRONTEND and/or SHELL from the environment\n"; + print STDERR "'Defaults:" . $conf->get('USERNAME') . " env_keep+=\"APT_CONFIG DEBIAN_FRONTEND SHELL\"' is not set in /etc/sudoers\n"; + die "$sudo is incorrectly configured" + } + } + }, + DEFAULT => 'sudo', + HELP => 'Path to sudo binary' + }, + 'SU' => { + TYPE => 'STRING', + VARNAME => 'su', + GROUP => 'Programs', + CHECK => $validate_program, + DEFAULT => 'su', + HELP => 'Path to su binary' + }, + 'SCHROOT' => { + TYPE => 'STRING', + GROUP => '__INTERNAL', + CHECK => sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + + # Only validate if needed. + if ($conf->get('CHROOT_MODE') eq 'schroot') { + $validate_program->($conf, $entry); + } + }, + DEFAULT => 'schroot', + HELP => 'Path to schroot binary' + }, + 'SCHROOT_OPTIONS' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'schroot_options', + GROUP => 'Programs', + DEFAULT => ['-q'], + HELP => 'Additional command-line options for schroot' + }, + 'UNSHARE_TMPDIR_TEMPLATE' => { + TYPE => 'STRING', + VARNAME => 'unshare_tmpdir_template', + GROUP => 'Programs', + DEFAULT => '/tmp/tmp.sbuild.XXXXXXXXXX', + HELP => 'Template used to create the temporary unpack directory for the unshare chroot mode.' + # CLI_OPTIONS => ['--unshare-tmpdir-template'] + }, + 'UNSHARE_BIND_MOUNTS' => { + TYPE => 'ARRAY', + VARNAME => 'unshare_bind_mounts', + GROUP => 'Programs', + CHECK => sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + for my $entry (@{$conf->get($key)}) { + die "$entry->{directory} doesn't exist" if ! -e $entry->{directory}; + die "mountpoint $entry->{mountpoint} must be an absolute path inside the chroot" if $entry->{mountpoint} !~ /^\//; + } + }, + DEFAULT => [], + HELP => 'Bind mount directories from the outside to a mountpoint inside the chroot in unshare mode.', + EXAMPLE => '$unshare_bind_mounts = [ { directory => "/home/path/outside", mountpoint => "/path/inside" } ];' + }, + 'AUTOPKGTEST_VIRT_SERVER' => { + TYPE => 'STRING', + VARNAME => 'autopkgtest_virt_server', + GROUP => 'Programs', + CHECK => sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + my $program = $conf->get($key); + + # if the autopkgtest virtualization server name is only letters + # a-z then it is missing the autopkgtest-virt- prefix + if ($program =~ /^[a-z]+$/) { + $conf->set($key, "autopkgtest-virt-$program"); + } + + # Only validate if needed. + if ($conf->get('CHROOT_MODE') eq 'autopkgtest') { + $validate_program->($conf, $entry); + } + }, + DEFAULT => 'autopkgtest-virt-schroot', + HELP => 'Path to autopkgtest-virt-* binary, selecting the virtualization server.', + CLI_OPTIONS => ['--autopkgtest-virt-server'] + }, + 'AUTOPKGTEST_VIRT_SERVER_OPTIONS' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'autopkgtest_virt_server_options', + GROUP => 'Programs', + DEFAULT => [], + GET => sub { + my $conf = shift; + my $entry = shift; + + my $retval = $conf->_get($entry->{'NAME'}); + + my $dist = $conf->get('DISTRIBUTION'); + my $hostarch = $conf->get('HOST_ARCH'); + my %percent = ( + '%' => '%', + 'a' => $hostarch, 'SBUILD_HOST_ARCH' => $hostarch, + 'r' => $dist, 'SBUILD_DISTRIBUTION' => $dist, + ); + + my $keyword_pat = join("|", + sort {length $b <=> length $a || $a cmp $b} keys %percent); + foreach (@{$retval}) { + s{ + # Match a percent followed by a valid keyword + \%($keyword_pat) + }{ + # Substitute with the appropriate value only if it's defined + $percent{$1} || $& + }msxge; + } + return $retval; + }, + HELP => 'Additional command-line options for autopkgtest-virt-*', + CLI_OPTIONS => ['--autopkgtest-virt-server-opt', '--autopkgtest-virt-server-opts'] + }, + # Do not check for the existance of fakeroot because it's needed + # inside the chroot and not on the host + 'FAKEROOT' => { + TYPE => 'STRING', + VARNAME => 'fakeroot', + GROUP => 'Programs', + DEFAULT => 'fakeroot', + HELP => 'Path to fakeroot binary' + }, + 'APT_GET' => { + TYPE => 'STRING', + VARNAME => 'apt_get', + GROUP => 'Programs', + CHECK => $validate_program, + DEFAULT => 'apt-get', + HELP => 'Path to apt-get binary' + }, + 'APT_CACHE' => { + TYPE => 'STRING', + VARNAME => 'apt_cache', + GROUP => 'Programs', + CHECK => $validate_program, + DEFAULT => 'apt-cache', + HELP => 'Path to apt-cache binary' + }, + 'APTITUDE' => { + TYPE => 'STRING', + VARNAME => 'aptitude', + GROUP => 'Programs', + CHECK => sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + + # Only validate if needed. + if ($conf->get('BUILD_DEP_RESOLVER') eq 'aptitude') { + $validate_program->($conf, $entry); + } + }, + DEFAULT => 'aptitude', + HELP => 'Path to aptitude binary' + }, + 'XAPT' => { + TYPE => 'STRING', + VARNAME => 'xapt', + GROUP => 'Programs', + CHECK => sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + + # Only validate if needed. + if ($conf->get('BUILD_DEP_RESOLVER') eq 'xapt') { + $validate_program->($conf, $entry); + } + }, + DEFAULT => 'xapt' + }, + 'DPKG_BUILDPACKAGE_USER_OPTIONS' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'dpkg_buildpackage_user_options', + GROUP => 'Programs', + DEFAULT => [], + HELP => 'Additional command-line options for dpkg-buildpackage.', + CLI_OPTIONS => ['--debbuildopt', '--debbuildopts', '--jobs'] + }, + 'DPKG_FILE_SUFFIX' => { + TYPE => 'STRING', + VARNAME => 'dpkg_file_suffix', + GROUP => 'Programs', + DEFAULT => '', + HELP => 'Suffix to add to filename for files generated by dpkg-buildpackage', + CLI_OPTIONS => ['--dpkg-file-suffix'] + }, + 'DPKG_SOURCE' => { + TYPE => 'STRING', + VARNAME => 'dpkg_source', + GROUP => 'Programs', + CHECK => $validate_program, + DEFAULT => 'dpkg-source', + HELP => 'Path to dpkg-source binary' + }, + 'DPKG_SOURCE_OPTIONS' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'dpkg_source_opts', + GROUP => 'Programs', + DEFAULT => [], + HELP => 'Additional command-line options for dpkg-source', + CLI_OPTIONS => ['--dpkg-source-opt', '--dpkg-source-opts'] + }, + 'MD5SUM' => { + TYPE => 'STRING', + VARNAME => 'md5sum', + GROUP => 'Programs', + CHECK => $validate_program, + DEFAULT => 'md5sum', + HELP => 'Path to md5sum binary' + }, + 'STATS_DIR' => { + TYPE => 'STRING', + VARNAME => 'stats_dir', + GROUP => 'Statistics', + IGNORE_DEFAULT => 1, # Don't dump the current home + DEFAULT => "$HOME/stats", + HELP => 'Directory for writing build statistics to', + CLI_OPTIONS => ['--stats-dir'] + }, + 'PACKAGE_CHECKLIST' => { + TYPE => 'STRING', + VARNAME => 'package_checklist', + GROUP => 'Chroot options', + DEFAULT => "$Sbuild::Sysconfig::paths{'SBUILD_LOCALSTATE_DIR'}/package-checklist", + HELP => 'Where to store list currently installed packages inside chroot' + }, + 'BUILD_ENV_CMND' => { + TYPE => 'STRING', + VARNAME => 'build_env_cmnd', + GROUP => 'Build options', + DEFAULT => "", + HELP => 'This command is run with the dpkg-buildpackage command line passed to it (in the chroot, if doing a chrooted build). It is used by the sparc buildd (which is sparc64) to call the wrapper script that sets the environment to sparc (32-bit). It could be used for other build environment setup scripts. Note that this is superseded by schroot\'s \'command-prefix\' option' + }, + 'PGP_OPTIONS' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'pgp_options', + GROUP => 'Build options', + DEFAULT => ['-us', '-uc'], + HELP => 'Additional signing options for dpkg-buildpackage' + }, + 'LOG_DIR' => { + TYPE => 'STRING', + VARNAME => 'log_dir', + GROUP => 'Logging options', + CHECK => sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + my $directory = $conf->get($key); + }, + GET => sub { + my $conf = shift; + my $entry = shift; + + my $retval = $conf->_get($entry->{'NAME'}); + + # user mode defaults to the build directory, while buildd mode + # defaults to $HOME/logs. + if (!defined($retval)) { + $retval = $conf->get('BUILD_DIR'); + if ($conf->get('SBUILD_MODE') eq 'buildd') { + $retval = "$HOME/logs"; + } + } + + return $retval; + }, + HELP => 'Directory for storing build logs. This defaults to \'.\' when SBUILD_MODE is set to \'user\' (the default), and to \'$HOME/logs\' when SBUILD_MODE is set to \'buildd\'.' + }, + 'LOG_COLOUR' => { + TYPE => 'BOOL', + VARNAME => 'log_colour', + GROUP => 'Logging options', + DEFAULT => 1, + HELP => 'Add colour highlighting to interactive log messages (informational, warning and error messages). Log files will not be coloured.' + }, + 'LOG_FILTER' => { + TYPE => 'BOOL', + VARNAME => 'log_filter', + GROUP => 'Logging options', + DEFAULT => 1, + HELP => 'Filter variable strings from log messages such as the chroot name and build directory' + }, + 'LOG_DIR_AVAILABLE' => { + TYPE => 'BOOL', + GROUP => '__INTERNAL', + GET => sub { + my $conf = shift; + my $entry = shift; + + my $nolog = $conf->get('NOLOG'); + my $directory = $conf->get('LOG_DIR'); + my $log_dir_available = 1; + + if ($nolog) { + $log_dir_available = 0; + } elsif ($conf->get('SBUILD_MODE') ne "buildd") { + if ($directory && ! -d $directory) { + $log_dir_available = 0; + } + } elsif ($directory && ! -d $directory && + !mkdir $directory) { + # Only create the log dir in buildd mode + warn "Could not create '$directory': $!\n"; + $log_dir_available = 0; + } + + return $log_dir_available; + } + }, + 'MAILTO' => { + TYPE => 'STRING', + VARNAME => 'mailto', + GROUP => 'Logging options', + CHECK => sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + }, + GET => sub { + my $conf = shift; + my $entry = shift; + + my $retval = $conf->_get($entry->{'NAME'}); + + # Now, we might need to adjust the MAILTO based on the + # config data. We shouldn't do this if it was already + # explicitly set by the command line option: + if (defined($conf->get('MAILTO_FORCED_BY_CLI')) && + !$conf->get('MAILTO_FORCED_BY_CLI') + && defined($conf->get('DISTRIBUTION')) + && $conf->get('DISTRIBUTION') + && defined($conf->get('MAILTO_HASH')) + && $conf->get('MAILTO_HASH')->{$conf->get('DISTRIBUTION')}) { + $retval = $conf->get('MAILTO_HASH')->{$conf->get('DISTRIBUTION')}; + } + + return $retval; + }, + DEFAULT => "", + HELP => 'email address to mail build logs to', + CLI_OPTIONS => ['--mail-log-to'] + }, + 'MAILTO_FORCED_BY_CLI' => { + TYPE => 'BOOL', + GROUP => '__INTERNAL', + DEFAULT => 0 + }, + 'MAILTO_HASH' => { + TYPE => 'HASH:STRING', + VARNAME => 'mailto_hash', + GROUP => 'Logging options', + DEFAULT => {}, + HELP => 'Like MAILTO, but per-distribution. This is a hashref mapping distribution name to MAILTO. Note that for backward compatibility, this is also settable using the hash %mailto (deprecated), rather than a hash reference.' + }, + 'MAILFROM' => { + TYPE => 'STRING', + VARNAME => 'mailfrom', + GROUP => 'Logging options', + DEFAULT => "Source Builder <sbuild>", + HELP => 'email address set in the From line of build logs', + CLI_OPTIONS => ['--mailfrom'] + }, + 'COMPRESS_BUILD_LOG_MAILS' => { + TYPE => 'BOOL', + VARNAME => 'compress_build_log_mails', + GROUP => 'Logging options', + DEFAULT => 1, + HELP => 'Should build log mails be compressed?' + }, + 'MIME_BUILD_LOG_MAILS' => { + TYPE => 'BOOL', + VARNAME => 'mime_build_log_mails', + GROUP => 'Logging options', + DEFAULT => 1, + HELP => 'Should build log mails be MIME encoded?' + }, + 'PURGE_BUILD_DEPS' => { + TYPE => 'STRING', + VARNAME => 'purge_build_deps', + GROUP => 'Chroot options', + CHECK => sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + + die "Bad purge mode \'" . + $conf->get('PURGE_BUILD_DEPS') . "\'" + if !isin($conf->get('PURGE_BUILD_DEPS'), + qw(always successful never)); + }, + DEFAULT => 'always', + HELP => 'When to purge the build dependencies after a build; possible values are "never", "successful", and "always"', + CLI_OPTIONS => ['-p', '--purge', '--purge-deps'] + }, + 'PURGE_BUILD_DIRECTORY' => { + TYPE => 'STRING', + VARNAME => 'purge_build_directory', + GROUP => 'Chroot options', + CHECK => sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + + die "Bad purge mode \'" . + $conf->get('PURGE_BUILD_DIRECTORY') . "\'" + if !isin($conf->get('PURGE_BUILD_DIRECTORY'), + qw(always successful never)); + }, + DEFAULT => 'always', + HELP => 'When to purge the build directory after a build; possible values are "never", "successful", and "always"', + CLI_OPTIONS => ['-p', '--purge', '--purge-build'] + }, + 'PURGE_SESSION' => { + TYPE => 'STRING', + VARNAME => 'purge_session', + GROUP => 'Chroot options', + CHECK => sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + + die "Bad purge mode \'" . + $conf->get('PURGE_SESSION') . "\'" + if !isin($conf->get('PURGE_SESSION'), + qw(always successful never)); + }, + DEFAULT => 'always', + HELP => 'Purge the schroot session following a build. This is useful in conjunction with the --purge and --purge-deps options when using snapshot chroots, since by default the snapshot will be deleted. Possible values are "always" (default), "never", and "successful"', + CLI_OPTIONS => ['-p', '--purge', '--purge-session'] + }, + 'TOOLCHAIN_REGEX' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'toolchain_regex', + GROUP => 'Build options', + DEFAULT => ['binutils$', + 'dpkg-dev$', + 'gcc-[\d.]+$', + 'g\+\+-[\d.]+$', + 'libstdc\+\+', + 'libc[\d.]+-dev$', + 'linux-kernel-headers$', + 'linux-libc-dev$', + 'gnumach-dev$', + 'hurd-dev$', + 'kfreebsd-kernel-headers$' + ], + HELP => 'Regular expressions identifying toolchain packages. Note that for backward compatibility, this is also settable using the array @toolchain_regex (deprecated), rather than an array reference.' + }, + 'STALLED_PKG_TIMEOUT' => { + TYPE => 'NUMERIC', + VARNAME => 'stalled_pkg_timeout', + GROUP => 'Build timeouts', + DEFAULT => 150, # minutes + HELP => 'Time (in minutes) of inactivity after which a build is terminated. Activity is measured by output to the log file.' + }, + 'MAX_LOCK_TRYS' => { + TYPE => 'NUMERIC', + VARNAME => 'max_lock_trys', + GROUP => 'Build timeouts', + DEFAULT => 120, + HELP => 'Number of times to try waiting for a lock.' + }, + 'LOCK_INTERVAL' => { + TYPE => 'NUMERIC', + VARNAME => 'lock_interval', + GROUP => 'Build timeouts', + DEFAULT => 5, + HELP => 'Lock wait interval (seconds). Maximum wait time is (max_lock_trys x lock_interval).' + }, + 'CHROOT_MODE' => { + TYPE => 'STRING', + VARNAME => 'chroot_mode', + GROUP => 'Chroot options', + CHECK => sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + + die "Bad chroot mode \'" . $conf->get('CHROOT_MODE') . "\'" + if !isin($conf->get('CHROOT_MODE'), + qw(schroot sudo autopkgtest unshare)); + }, + DEFAULT => 'schroot', + HELP => 'Mechanism to use for chroot virtualisation. Possible value are "schroot" (default), "sudo", "autopkgtest" and "unshare".', + CLI_OPTIONS => ['--chroot-mode'] + }, + 'CHROOT_SPLIT' => { + TYPE => 'BOOL', + VARNAME => 'chroot_split', + GROUP => 'Chroot options', + DEFAULT => 0, + HELP => 'Run in split mode? In split mode, apt-get and dpkg are run on the host system, rather than inside the chroot.' + }, + 'CHECK_SPACE' => { + TYPE => 'BOOL', + VARNAME => 'check_space', + GROUP => 'Build options', + DEFAULT => 1, + HELP => 'Check free disk space prior to starting a build. sbuild requires the free space to be at least twice the size of the unpacked sources to allow a build to proceed. Can be disabled to allow building if space is very limited, but the threshold to abort a build has been exceeded despite there being sufficient space for the build to complete.' + }, + 'BUILD_DIR' => { + TYPE => 'STRING', + VARNAME => 'build_dir', + GROUP => 'Core options', + DEFAULT => cwd(), + IGNORE_DEFAULT => 1, # Don't dump class to config + EXAMPLE => '$build_dir = \'/home/pete/build\';', + CHECK => $validate_directory, + HELP => 'Output directory for build artifacts created by dpkg-buildpackage and the log file. Defaults to the current directory if unspecified. It is used as the location of chroot symlinks (obsolete) and for current build log symlinks and some build logs. There is no default; if unset, it defaults to the current working directory. $HOME/build is another common configuration.', + CLI_OPTIONS => ['--build-dir'] + }, + 'BUILD_PATH' => { + TYPE => 'STRING', + VARNAME => 'build_path', + GROUP => 'Build options', + DEFAULT => undef, + HELP => 'By default the package is built in a path of the following format /build/packagename-XXXXXX/packagename-version/ where XXXXXX is a random ascii string. This option allows one to specify a custom path where the package is built inside the chroot. The sbuild user in the chroot must have permissions to create the path. Common writable locations are subdirectories of /tmp or /build. Using /tmp might be dangerous, because (depending on the chroot backend) the /tmp inside the chroot might be a world writable location that can be accessed by processes outside the chroot. The directory /build can only be accessed by the sbuild user and group and should be a safe location. The buildpath must be an empty directory because the last component of the path will be removed after the build is finished. Notice that depending on the chroot backend (see CHROOT_MODE), some locations inside the chroot might be bind mounts that are shared with other sbuild instances. You must avoid using these shared locations as the build path or otherwise concurrent runs of sbuild will likely fail. With the default schroot chroot backend, the directory /build is shared between multiple schroot sessions. You can change this behaviour in /etc/schroot/sbuild/fstab. The behaviour of other chroot backends will vary.', + CLI_OPTIONS => ['--build-path'] + }, + 'DSC_DIR' => { + TYPE => 'STRING', + VARNAME => 'dsc_dir', + GROUP => 'Build options', + DEFAULT => undef, + HELP => 'By default the package is built in a path of the following format /build/packagename-XXXXXX/packagename-version/ where packagename-version are replaced by the values in debian/changelog. This option allows one to specify a custom packagename-version path where the package is built inside the chroot. This is useful to specify a static path for different versions for example for ccache.', + CLI_OPTIONS => ['--dsc-dir'] + }, + 'SBUILD_MODE' => { + TYPE => 'STRING', + VARNAME => 'sbuild_mode', + GROUP => 'Core options', + DEFAULT => 'user', + HELP => 'sbuild behaviour; possible values are "user" (exit status reports build failures) and "buildd" (exit status does not report build failures) for use in a buildd setup. "buildd" also currently implies enabling of "legacy features" such as chroot symlinks in the build directory and the creation of current symlinks in the build directory.', + CLI_OPTIONS => ['--sbuild-mode'] + }, + 'CHROOT_SETUP_SCRIPT' => { + TYPE => 'STRING', + VARNAME => 'chroot_setup_script', + GROUP => 'Chroot options', + DEFAULT => undef, + HELP => 'Script to run to perform custom setup tasks in the chroot.', + CLI_OPTIONS => ['--setup-hook'] + }, + 'FORCE_ORIG_SOURCE' => { + TYPE => 'BOOL', + VARNAME => 'force_orig_source', + GROUP => 'Build options', + DEFAULT => 0, + HELP => 'By default, the -s option only includes the .orig.tar.gz when needed (i.e. when the Debian revision is 0 or 1). By setting this option to 1, the .orig.tar.gz will always be included when -s is used.', + CLI_OPTIONS => ['--force-orig-source'] + }, + 'INDIVIDUAL_STALLED_PKG_TIMEOUT' => { + TYPE => 'HASH:NUMERIC', + VARNAME => 'individual_stalled_pkg_timeout', + GROUP => 'Build timeouts', + DEFAULT => {}, + HELP => 'Some packages may exceed the general timeout (e.g. redirecting output to a file) and need a different timeout. This has is a mapping between source package name and timeout. Note that for backward compatibility, this is also settable using the hash %individual_stalled_pkg_timeout (deprecated) , rather than a hash reference.', + EXAMPLE => +'$individual_stalled_pkg_timeout->{\'llvm-toolchain-3.8\'} = 300; +$individual_stalled_pkg_timeout->{\'kicad-packages3d\'} = 90;' + }, + 'ENVIRONMENT_FILTER' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'environment_filter', + GROUP => 'Core options', + DEFAULT => [ sort (map "^$_\$", Dpkg::BuildInfo::get_build_env_allowed()) ], +# GET => sub { +# my $conf = shift; +# my $entry = shift; +# +# my $retval = $conf->_get($entry->{'NAME'}); +# +# if (!defined($retval)) { +# $retval = [ map "^$_\$", Dpkg::BuildInfo::get_build_env_allowed() ]; +# } +# +# return $retval; +# }, + HELP => 'Only environment variables matching one of the regular expressions in this arrayref will be passed to dpkg-buildpackage and other programs run by sbuild. The default value for this configuration setting is the list of variable names as returned by Dpkg::BuildInfo::get_build_env_allowed() which is also the list of variable names that is whitelisted to be recorded in .buildinfo files. Caution: the default value listed below was retrieved from the dpkg Perl library version available when this man page was generated. It might be different if your dpkg Perl library version differs.', + EXAMPLE => +'# Setting the old environment filter +$environment_filter = [\'^PATH$\', + \'^DEB(IAN|SIGN)?_[A-Z_]+$\', + \'^(C(PP|XX)?|LD|F)FLAGS(_APPEND)?$\', + \'^USER(NAME)?$\', + \'^LOGNAME$\', + \'^HOME$\', + \'^TERM$\', + \'^SHELL$\']; +# Appending FOOBAR to the default +use Dpkg::Build::Info; +$environment_filter = [Dpkg::BuildInfo::get_build_env_allowed(), \'FOOBAR\']; +# Removing FOOBAR from the default +use Dpkg::Build::Info; +$environment_filter = [map /^FOOBAR$/ ? () : $_, Dpkg::BuildInfo::get_build_env_allowed()]; +' + }, + 'BUILD_ENVIRONMENT' => { + TYPE => 'HASH:STRING', + VARNAME => 'build_environment', + GROUP => 'Core options', + DEFAULT => {}, + HELP => 'Environment to set during the build. Defaults to setting PATH and LD_LIBRARY_PATH only. Note that these environment variables are not subject to filtering with ENVIRONMENT_FILTER. Example:', + EXAMPLE => +'$build_environment = { + \'CCACHE_DIR\' => \'/build/cache\' +};' + }, + 'LD_LIBRARY_PATH' => { + TYPE => 'STRING', + VARNAME => 'ld_library_path', + GROUP => 'Build environment', + DEFAULT => undef, + HELP => 'Library search path to use inside the chroot.', + CLI_OPTIONS => ['--use-snapshot'] + }, + 'MAINTAINER_NAME' => { + TYPE => 'STRING', + VARNAME => 'maintainer_name', + GROUP => 'Maintainer options', + DEFAULT => undef, + SET => $set_signing_option, + HELP => 'Name to use as override in .changes files for the Maintainer field. The Maintainer field will not be overridden unless set here.', + CLI_OPTIONS => ['-m', '--maintainer'] + }, + 'UPLOADER_NAME' => { + VARNAME => 'uploader_name', + TYPE => 'STRING', + GROUP => 'Maintainer options', + DEFAULT => undef, + SET => $set_signing_option, + HELP => 'Name to use as override in .changes file for the Changed-By: field.', + CLI_OPTIONS => ['-e', '--uploader'] + }, + 'KEY_ID' => { + TYPE => 'STRING', + VARNAME => 'key_id', + GROUP => 'Maintainer options', + DEFAULT => undef, + HELP => 'Key ID to use in .changes for the current upload. It overrides both $maintainer_name and $uploader_name.', + CLI_OPTIONS => ['-k', '--keyid'] + }, + 'SIGNING_OPTIONS' => { + TYPE => 'STRING', + GROUP => '__INTERNAL', + DEFAULT => "", + HELP => 'PGP-related identity options to pass to dpkg-buildpackage. Usually neither .dsc nor .changes files are not signed automatically.' + }, + 'APT_CLEAN' => { + TYPE => 'BOOL', + VARNAME => 'apt_clean', + GROUP => 'Chroot options', + DEFAULT => 0, + HELP => 'APT clean. 1 to enable running "apt-get clean" at the start of each build, or 0 to disable.', + CLI_OPTIONS => ['--apt-clean', '--no-apt-clean'] + }, + 'APT_KEEP_DOWNLOADED_PACKAGES' => { + TYPE => 'BOOL', + VARNAME => 'apt_keep_downloaded_packages', + GROUP => 'Chroot options', + DEFAULT => 0, + HELP => 'Keep downloaded packages in cache by APT. Controls APT::Keep-Downloaded-Packages option used when downloading dependencies. This option only makes sense if /var/cache/apt/archive inside the chroot is made persistent between multiple sbuild invocations. 1 to keep downloaded packages in cache, or 0 to delete them after installation.' + }, + 'APT_UPDATE' => { + TYPE => 'BOOL', + VARNAME => 'apt_update', + GROUP => 'Chroot options', + DEFAULT => 1, + HELP => 'APT update. 1 to enable running "apt-get update" at the start of each build, or 0 to disable. This option has no effect on updating the internal sbuild apt repository, the repository for extra packages (see EXTRA_PACKAGES) and the repositories given via EXTRA_REPOSITORIES. These are always updated. Thus, this option only influences updates of the default repositories of the chroot.', + CLI_OPTIONS => ['--apt-update', '--no-apt-update'] + }, + 'APT_UPDATE_ARCHIVE_ONLY' => { + TYPE => 'BOOL', + VARNAME => 'apt_update_archive_only', + GROUP => 'Chroot options', + DEFAULT => 1, + HELP => 'Update local temporary APT archive directly (1, the default) or set to 0 to disable and do a full apt update (not recommended in case the mirror content has changed since the build started).' + }, + 'APT_UPGRADE' => { + TYPE => 'BOOL', + VARNAME => 'apt_upgrade', + GROUP => 'Chroot options', + DEFAULT => 0, + HELP => 'APT upgrade. 1 to enable running "apt-get upgrade" at the start of each build, or 0 to disable.', + CLI_OPTIONS => ['--apt-upgrade', '--no-apt-upgrade'] + }, + 'APT_DISTUPGRADE' => { + TYPE => 'BOOL', + VARNAME => 'apt_distupgrade', + GROUP => 'Chroot options', + DEFAULT => 1, + HELP => 'APT distupgrade. 1 to enable running "apt-get dist-upgrade" at the start of each build, or 0 to disable.', + CLI_OPTIONS => ['--apt-distupgrade', '--no-apt-distupgrade'] + }, + 'APT_ALLOW_UNAUTHENTICATED' => { + TYPE => 'BOOL', + VARNAME => 'apt_allow_unauthenticated', + GROUP => 'Chroot options', + DEFAULT => 0, + HELP => 'Force APT to accept unauthenticated packages. By default, unauthenticated packages are not allowed. This is to keep the build environment secure, using apt-secure(8). By setting this to 1, APT::Get::AllowUnauthenticated is set to "true" when running apt-get. This is disabled by default: only enable it if you know what you are doing.' + }, + 'BATCH_MODE' => { + TYPE => 'BOOL', + VARNAME => 'batch_mode', + GROUP => 'Core options', + DEFAULT => 0, + HELP => 'Enable batch mode?', + CLI_OPTIONS => ['-b', '--batch'] + }, + 'CORE_DEPENDS' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'core_depends', + GROUP => 'Core options', + DEFAULT => ['build-essential:native', 'fakeroot:native'], + HELP => 'Packages which must be installed in the chroot for all builds.' + }, + 'MANUAL_DEPENDS' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'manual_depends', + GROUP => 'Core options', + DEFAULT => [], + HELP => 'Additional per-build dependencies.', + CLI_OPTIONS => ['--add-depends'] + }, + 'MANUAL_CONFLICTS' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'manual_conflicts', + GROUP => 'Core options', + DEFAULT => [], + HELP => 'Additional per-build dependencies.', + CLI_OPTIONS => ['--add-conflicts'] + }, + 'MANUAL_DEPENDS_ARCH' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'manual_depends_arch', + GROUP => 'Core options', + DEFAULT => [], + HELP => 'Additional per-build dependencies.', + CLI_OPTIONS => ['--add-depends-arch'] + }, + 'MANUAL_CONFLICTS_ARCH' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'manual_conflicts_arch', + GROUP => 'Core options', + DEFAULT => [], + HELP => 'Additional per-build dependencies.', + CLI_OPTIONS => ['--add-conflicts-arch'] + }, + 'MANUAL_DEPENDS_INDEP' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'manual_depends_indep', + GROUP => 'Core options', + DEFAULT => [], + HELP => 'Additional per-build dependencies.', + CLI_OPTIONS => ['--add-depends-indep'] + }, + 'MANUAL_CONFLICTS_INDEP' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'manual_conflicts_indep', + GROUP => 'Core options', + DEFAULT => [], + HELP => 'Additional per-build dependencies.', + CLI_OPTIONS => ['--add-conflicts-indep'] + }, + 'CROSSBUILD_CORE_DEPENDS' => { + TYPE => 'HASH:ARRAY:STRING', + VARNAME => 'crossbuild_core_depends', + GROUP => 'Multiarch support (transitional)', + DEFAULT => {}, + HELP => 'Per-architecture dependencies required for cross-building. By default, if a Debian architecture is not found as a key in this hash, the following will be added to the Build-Depends: crossbuild-essential-${hostarch}:native, libc-dev, libstdc++-dev. The latter two are to work around bug #815172.', + EXAMPLE => ' +$crossbuild_core_depends = { + nios2 => [\'crossbuild-essential-nios2:native\', \'special-package\'], + musl-linux-mips => [\'crossbuild-essential-musl-linux-mips:native\', \'super-special\'], +} +' + }, 'BUILD_SOURCE' => { + TYPE => 'BOOL', + VARNAME => 'build_source', + GROUP => 'Build options', + DEFAULT => 0, + CHECK => $validate_append_version, + HELP => 'By default, do not build a source package (binary only build). Set to 1 to force creation of a source package, but note that this is inappropriate for binary NMUs, where the option will always be disabled.', + CLI_OPTIONS => ['-s', '--source', '--no-source'] + }, + 'ARCHIVE' => { + TYPE => 'STRING', + VARNAME => 'archive', + GROUP => 'Core options', + DEFAULT => undef, + HELP => 'Archive being built. Only set in build log. This might be useful for derivative distributions.', + CLI_OPTIONS => ['--archive'] + }, + 'BIN_NMU' => { + TYPE => 'STRING', + VARNAME => 'bin_nmu', + GROUP => 'Build options', + DEFAULT => undef, + CHECK => $validate_append_version, + HELP => 'Binary NMU changelog entry.', + CLI_OPTIONS => ['--make-binNMU'] + }, + 'BIN_NMU_VERSION' => { + TYPE => 'STRING', + VARNAME => 'bin_nmu_version', + GROUP => 'Build options', + DEFAULT => undef, + HELP => 'Binary NMU version number.', + CLI_OPTIONS => ['--binNMU', '--make-binNMU'] + }, + 'BIN_NMU_TIMESTAMP' => { + TYPE => 'STRING', + VARNAME => 'bin_nmu_timestamp', + GROUP => 'Build options', + DEFAULT => undef, + HELP => 'Binary NMU timestamp. The timestamp is either given as n integer in Unix time or as a string in the format compatible with Debian changelog entries (i.e. as it is generated by date -R). If set to the default (undef) the date at build time is used.', + CLI_OPTIONS => ['--binNMU-timestamp'] + }, + 'APPEND_TO_VERSION' => { + TYPE => 'STRING', + VARNAME => 'append_to_version', + GROUP => 'Build options', + DEFAULT => undef, + CHECK => $validate_append_version, + HELP => 'Suffix to append to version number. May be useful for derivative distributions.', + CLI_OPTIONS => ['--append-to-version'] + }, + 'BIN_NMU_CHANGELOG' => { + TYPE => 'STRING', + VARNAME => 'bin_nmu_changelog', + GROUP => 'Build options', + DEFAULT => undef, + HELP => 'The content of a binary-only changelog entry. Leading and trailing newlines will be stripped.', + CLI_OPTIONS => ['--binNMU-changelog'] + }, + 'GCC_SNAPSHOT' => { + TYPE => 'BOOL', + VARNAME => 'gcc_snapshot', + GROUP => 'Build options', + DEFAULT => 0, + HELP => 'Build using current GCC snapshot?', + CLI_OPTIONS => ['--use-snapshot'] + }, + 'JOB_FILE' => { + TYPE => 'STRING', + VARNAME => 'job_file', + GROUP => 'Core options', + DEFAULT => 'build-progress', + HELP => 'Job status file (only used in batch mode)' + }, + 'BUILD_DEP_RESOLVER' => { + TYPE => 'STRING', + VARNAME => 'build_dep_resolver', + GROUP => 'Dependency resolution', + DEFAULT => 'apt', + CHECK => sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + + if ($conf->get($key) eq 'internal') { + warn "W: Build dependency resolver 'internal' has been removed; defaulting to 'apt'. Please update your configuration.\n"; + $conf->set('BUILD_DEP_RESOLVER', 'apt'); + } + + die '$key: Invalid build-dependency resolver \'' . + $conf->get($key) . + "'\nValid algorithms are 'apt', 'aptitude', 'aspcud', 'xapt', and 'null'\n" + if !isin($conf->get($key), + qw(apt aptitude aspcud xapt null)); + }, + HELP => 'Build dependency resolver. The \'apt\' resolver is currently the default, and recommended for most users. This resolver uses apt-get to resolve dependencies. Alternative resolvers are \'apt\', \'aptitude\' and \'aspcud\'. The \'apt\' resolver uses a built-in resolver module while the \'aptitude\' resolver uses aptitude to resolve build dependencies. The aptitude resolver is similar to apt, but is useful in more complex situations, such as where multiple distributions are required, for example when building from experimental, where packages are needed from both unstable and experimental, but defaulting to unstable. If the dependency situation is too complex for either apt or aptitude to solve it, you can use the \'aspcud\' resolver which (in contrast to apt and aptitude) is a real solver (in the math sense) and will thus always find a solution if a solution exists. Additionally, the \'null\' solver is provided. It is a dummy resolver which does not install, upgrade or remove any packages. This allows one to completely control package installation via hooks.', + CLI_OPTIONS => ['--build-dep-resolver'] + }, + 'ASPCUD_CRITERIA' => { + TYPE => 'STRING', + VARNAME => 'aspcud_criteria', + GROUP => 'Dependency resolution', + DEFAULT => '-removed,-changed,-new', + HELP => 'Optimization criteria in extended MISC 2012 syntax passed to aspcud through apt-cudf. Optimization criteria are separated by commas, sorted by decreasing order of priority and are prefixed with a polarity (+ to maximize and - to minimize). The default criteria is \'-removed,-changed,-new\' which first minimizes the number of removed packages, then the number of changed packages (up or downgrades) and then the number of new packages. A common task is to minimize the number of packages from experimental. To do this you can add a criteria like \'-count(solution,APT-Release:=/a=experimental/)\' to the default criteria. This will then minimize the number of packages in the solution which contain the string \'a=experimental\' in the \'APT-Release\' field of the EDSP output created by apt. See the apt-cudf man page help on the --criteria option for more information.', + CLI_OPTIONS => ['--aspcud-criteria'] + }, + 'CLEAN_SOURCE' => { + TYPE => 'BOOL', + VARNAME => 'clean_source', + GROUP => 'Build options', + DEFAULT => 1, + HELP => 'When running sbuild from within an unpacked source tree, run the \'clean\' target before generating the source package. This might require some of the build dependencies necessary for running the \'clean\' target to be installed on the host machine. Only disable if you start from a clean checkout and you know what you are doing.', + CLI_OPTIONS => ['--clean-source', '--no-clean-source'] + }, + 'LINTIAN' => { + TYPE => 'STRING', + VARNAME => 'lintian', + GROUP => 'Build validation', + DEFAULT => 'lintian', + HELP => 'Path to lintian binary' + }, + 'RUN_LINTIAN' => { + TYPE => 'BOOL', + VARNAME => 'run_lintian', + GROUP => 'Build validation', + CHECK => sub { + my $conf = shift; + $conf->check('LINTIAN'); + }, + DEFAULT => 1, + HELP => 'Run lintian?', + CLI_OPTIONS => ['--run-lintian', '--no-run-lintian'] + }, + 'LINTIAN_OPTIONS' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'lintian_opts', + GROUP => 'Build validation', + DEFAULT => [], + HELP => 'Options to pass to lintian. Each option is a separate arrayref element. For example, [\'-i\', \'-v\'] to add -i and -v.', + CLI_OPTIONS => ['--lintian-opt', '--lintian-opts'] + }, + 'LINTIAN_REQUIRE_SUCCESS' => { + TYPE => 'BOOL', + VARNAME => 'lintian_require_success', + GROUP => 'Build validation', + DEFAULT => 0, + HELP => 'Let sbuild fail if lintian fails.' + }, + 'PIUPARTS' => { + TYPE => 'STRING', + VARNAME => 'piuparts', + GROUP => 'Build validation', + CHECK => sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + + # Only validate if needed. + if ($conf->get('RUN_PIUPARTS')) { + $validate_program->($conf, $entry); + } + }, + DEFAULT => 'piuparts', + HELP => 'Path to piuparts binary', + CLI_OPTIONS => ['--piuparts-opt', '--piuparts-opts'] + }, + 'RUN_PIUPARTS' => { + TYPE => 'BOOL', + VARNAME => 'run_piuparts', + GROUP => 'Build validation', + CHECK => sub { + my $conf = shift; + $conf->check('PIUPARTS'); + }, + DEFAULT => 0, + HELP => 'Run piuparts', + CLI_OPTIONS => ['--run-piuparts', '--no-run-piuparts'] + }, + 'PIUPARTS_OPTIONS' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'piuparts_opts', + GROUP => 'Build validation', + DEFAULT => [], + GET => sub { + my $conf = shift; + my $entry = shift; + + my $retval = $conf->_get($entry->{'NAME'}); + + my $dist = $conf->get('DISTRIBUTION'); + my $hostarch = $conf->get('HOST_ARCH'); + my %percent = ( + '%' => '%', + 'a' => $hostarch, 'SBUILD_HOST_ARCH' => $hostarch, + 'r' => $dist, 'SBUILD_DISTRIBUTION' => $dist, + ); + + my $keyword_pat = join("|", + sort {length $b <=> length $a || $a cmp $b} keys %percent); + foreach (@{$retval}) { + s{ + # Match a percent followed by a valid keyword + \%($keyword_pat) + }{ + # Substitute with the appropriate value only if it's defined + $percent{$1} || $& + }msxge; + } + return $retval; + }, + HELP => 'Options to pass to piuparts. Each option is a separate arrayref element. For example, [\'-b\', \'<chroot_tarball>\'] to add -b and <chroot_tarball>.' + }, + 'PIUPARTS_ROOT_ARGS' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'piuparts_root_args', + GROUP => 'Build validation', + DEFAULT => [], + HELP => 'Preceding arguments to launch piuparts as root. With the default value (the empty array) "sudo --" will be used as a prefix. If the first element in the array is the empty string, no prefixing will be done. If the value is a scalar, it will be prefixed by that string. If the scalar is an empty string, no prefixing will be done.', + EXAMPLE => +'# prefix with "sudo --": +$piuparts_root_args = []; +$piuparts_root_args = [\'sudo\', \'--\']; +# prefix with "env": +$piuparts_root_args = [\'env\']; +$piuparts_root_args = \'env\'; +# prefix with nothing: +$piuparts_root_args = \'\'; +$piuparts_root_args = [\'\']; +$piuparts_root_args = [\'\', \'whatever\']; +', + CLI_OPTIONS => ['--piuparts-root-arg', '--piuparts-root-args'] + }, + 'PIUPARTS_REQUIRE_SUCCESS' => { + TYPE => 'BOOL', + VARNAME => 'piuparts_require_success', + GROUP => 'Build validation', + DEFAULT => 0, + HELP => 'Let sbuild fail if piuparts fails.' + }, + 'AUTOPKGTEST' => { + TYPE => 'STRING', + VARNAME => 'autopkgtest', + GROUP => 'Build validation', + CHECK => sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + + # Only validate if needed. + if ($conf->get('RUN_AUTOPKGTEST')) { + $validate_program->($conf, $entry); + } + }, + DEFAULT => 'autopkgtest', + HELP => 'Path to autopkgtest binary', + CLI_OPTIONS => ['--autopkgtest-opt', '--autopkgtest-opts'] + }, + 'RUN_AUTOPKGTEST' => { + TYPE => 'BOOL', + VARNAME => 'run_autopkgtest', + GROUP => 'Build validation', + CHECK => sub { + my $conf = shift; + $conf->check('AUTOPKGTEST'); + }, + DEFAULT => 0, + HELP => 'Run autopkgtest', + CLI_OPTIONS => ['--run-autopkgtest', '--no-run-autopkgtest'] + }, + 'AUTOPKGTEST_OPTIONS' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'autopkgtest_opts', + GROUP => 'Build validation', + DEFAULT => [], + GET => sub { + my $conf = shift; + my $entry = shift; + + my $retval = $conf->_get($entry->{'NAME'}); + + my $dist = $conf->get('DISTRIBUTION'); + my $hostarch = $conf->get('HOST_ARCH'); + my %percent = ( + '%' => '%', + 'a' => $hostarch, 'SBUILD_HOST_ARCH' => $hostarch, + 'r' => $dist, 'SBUILD_DISTRIBUTION' => $dist, + ); + + my $keyword_pat = join("|", + sort {length $b <=> length $a || $a cmp $b} keys %percent); + foreach (@{$retval}) { + s{ + # Match a percent followed by a valid keyword + \%($keyword_pat) + }{ + # Substitute with the appropriate value only if it's defined + $percent{$1} || $& + }msxge; + } + return $retval; + }, + HELP => 'Options to pass to autopkgtest. Each option is a separate arrayref element. For example, [\'-b\', \'<chroot_tarball>\'] to add -b and <chroot_tarball>.' + }, + 'AUTOPKGTEST_ROOT_ARGS' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'autopkgtest_root_args', + GROUP => 'Build validation', + DEFAULT => [], + HELP => 'Preceding arguments to launch autopkgtest as root. With the default value (the empty array) "sudo --" will be used as a prefix. If the first element in the array is the empty string, no prefixing will be done. If the value is a scalar, it will be prefixed by that string. If the scalar is an empty string, no prefixing will be done.', + EXAMPLE => +'# prefix with "sudo --": +$autopkgtest_root_args = []; +$autopkgtest_root_args = [\'sudo\', \'--\']; +# prefix with "env": +$autopkgtest_root_args = [\'env\']; +$autopkgtest_root_args = \'env\'; +# prefix with nothing: +$autopkgtest_root_args = \'\'; +$autopkgtest_root_args = [\'\']; +$autopkgtest_root_args = [\'\', \'whatever\']; +', + CLI_OPTIONS => ['--autopkgtest-root-arg', '--autopkgtest-root-args'] + }, + 'AUTOPKGTEST_REQUIRE_SUCCESS' => { + TYPE => 'BOOL', + VARNAME => 'autopkgtest_require_success', + GROUP => 'Build validation', + DEFAULT => 0, + HELP => 'Let sbuild fail if autopkgtest fails.' + }, + 'EXTERNAL_COMMANDS' => { + TYPE => 'HASH:ARRAY:STRING', + VARNAME => 'external_commands', + GROUP => 'Chroot options', + DEFAULT => { + "pre-build-commands" => [], + "chroot-setup-commands" => [], + "chroot-update-failed-commands" => [], + "build-deps-failed-commands" => [], + "build-failed-commands" => [], + "starting-build-commands" => [], + "finished-build-commands" => [], + "chroot-cleanup-commands" => [], + "post-build-commands" => [], + }, + HELP => 'External commands to run at various stages of a build. Commands are held in a hash of arrays of arrays data structure. There is no equivalent for the --anything-failed-commands command line option. All percent escapes mentioned in the sbuild man page can be used.', + EXAMPLE => +'# general format +$external_commands = { + "pre-build-commands" => [ + [\'foo\', \'arg1\', \'arg2\'], + [\'bar\', \'arg1\', \'arg2\', \'arg3\'], + ], + "chroot-setup-commands" => [ + [\'foo\', \'arg1\', \'arg2\'], + [\'bar\', \'arg1\', \'arg2\', \'arg3\'], + ], + "chroot-update-failed-commands" => [ + [\'foo\', \'arg1\', \'arg2\'], + [\'bar\', \'arg1\', \'arg2\', \'arg3\'], + ], + "build-deps-failed-commands" => [ + [\'foo\', \'arg1\', \'arg2\'], + [\'bar\', \'arg1\', \'arg2\', \'arg3\'], + ], + "build-failed-commands" => [ + [\'foo\', \'arg1\', \'arg2\'], + [\'bar\', \'arg1\', \'arg2\', \'arg3\'], + ], + "starting-build-commands" => [ + [\'foo\', \'arg1\', \'arg2\'], + [\'bar\', \'arg1\', \'arg2\', \'arg3\'], + ], + "finished-build-commands" => [ + [\'foo\', \'arg1\', \'arg2\'], + [\'bar\', \'arg1\', \'arg2\', \'arg3\'], + ], + "chroot-cleanup-commands" => [ + [\'foo\', \'arg1\', \'arg2\'], + [\'bar\', \'arg1\', \'arg2\', \'arg3\'], + ], + "post-build-commands" => [ + [\'foo\', \'arg1\', \'arg2\'], + [\'bar\', \'arg1\', \'arg2\', \'arg3\'], + ], + "post-build-failed-commands" => [ + [\'foo\', \'arg1\', \'arg2\'], + [\'bar\', \'arg1\', \'arg2\', \'arg3\'], + ], +}; +# the equivalent of specifying --anything-failed-commands=%SBUILD_SHELL on the +# command line +$external_commands = { + "chroot-update-failed-commands" => [ [ \'%SBUILD_SHELL\' ] ], + "build-deps-failed-commands" => [ [ \'%SBUILD_SHELL\' ] ], + "build-failed-commands" => [ [ \'%SBUILD_SHELL\' ] ], +};', + CLI_OPTIONS => ['--setup-hook', '--pre-build-commands', '--chroot-setup-commands', '--chroot-update-failed-commands', '--build-deps-failed-commands', '--build-failed-commands', '--anything-failed-commands', '--starting-build-commands', '--finished-build-commands', '--chroot-cleanup-commands', '--post-build-commands', '--post-build-failed-commands'] + }, + 'LOG_EXTERNAL_COMMAND_OUTPUT' => { + TYPE => 'BOOL', + VARNAME => 'log_external_command_output', + GROUP => 'Chroot options', + DEFAULT => 1, + HELP => 'Log standard output of commands run by sbuild?', + CLI_OPTIONS => ['--log-external-command-output'] + }, + 'LOG_EXTERNAL_COMMAND_ERROR' => { + TYPE => 'BOOL', + VARNAME => 'log_external_command_error', + GROUP => 'Chroot options', + DEFAULT => 1, + HELP => 'Log standard error of commands run by sbuild?', + CLI_OPTIONS => ['--log-external-command-error'] + }, + 'RESOLVE_ALTERNATIVES' => { + TYPE => 'BOOL', + VARNAME => 'resolve_alternatives', + GROUP => 'Dependency resolution', + DEFAULT => undef, + GET => sub { + my $conf = shift; + my $entry = shift; + + my $retval = $conf->_get($entry->{'NAME'}); + + if (!defined($retval)) { + $retval = 0; + $retval = 1 + if ($conf->get('BUILD_DEP_RESOLVER') eq 'aptitude'); + } + + return $retval; + }, + EXAMPLE => '$resolve_alternatives = 0;', + HELP => 'Should the dependency resolver use alternatives in Build-Depends, Build-Depends-Arch and Build-Depends-Indep? By default, using \'apt\' resolver, only the first alternative will be used; all other alternatives will be removed. When using the \'aptitude\' resolver, it will default to using all alternatives. Note that this does not include architecture-specific alternatives, which are reduced to the build architecture prior to alternatives removal. This should be left disabled when building for unstable; it may be useful when building for experimental or backports. Set to undef to use the default, 1 to enable, or 0 to disable.', + CLI_OPTIONS => ['--resolve-alternatives', '--no-resolve-alternatives'] + }, + 'EXTRA_PACKAGES' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'extra_packages', + GROUP => 'Dependency resolution', + DEFAULT => [], + HELP => 'Additional per-build packages available as build dependencies.', + CLI_OPTIONS => ['--extra-package'] + }, + 'EXTRA_REPOSITORY_KEYS' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'extra_repository_keys', + GROUP => 'Dependency resolution', + DEFAULT => [], + HELP => 'Additional per-build apt repository keys.', + CLI_OPTIONS => ['--extra-repository-key'] + }, + 'EXTRA_REPOSITORIES' => { + TYPE => 'ARRAY:STRING', + VARNAME => 'extra_repositories', + GROUP => 'Dependency resolution', + DEFAULT => [], + HELP => 'Additional per-build apt repositories.', + CLI_OPTIONS => ['--extra-repository'] + }, + 'SOURCE_ONLY_CHANGES' => { + TYPE => 'BOOL', + VARNAME => 'source_only_changes', + GROUP => 'Build options', + DEFAULT => 0, + HELP => 'Also produce a changes file suitable for a source-only upload.', + CLI_OPTIONS => ['--source-only-changes'] + }, + 'BD_UNINSTALLABLE_EXPLAINER' => { + TYPE => 'STRING', + VARNAME => 'bd_uninstallable_explainer', + GROUP => 'Dependency resolution', + CHECK => sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + + die "Bad bd-uninstallable explainer \'" . $conf->get('BD_UNINSTALLABLE_EXPLAINER') . "\'" + if defined $conf->get('BD_UNINSTALLABLE_EXPLAINER') + && !isin($conf->get('BD_UNINSTALLABLE_EXPLAINER'), + ('apt', 'dose3', '', 'none')); + }, + DEFAULT => 'dose3', + HELP => 'Method to use for explaining build dependency installation failures. Possible value are "dose3" (default), "apt" and "none". Set to "none", the empty string "" or Perl undef to disable running any explainer.', + CLI_OPTIONS => ['--bd-uninstallable-explainer'] + }, + 'PURGE_EXTRA_PACKAGES' => { + TYPE => 'BOOL', + VARNAME => 'purge_extra_packages', + GROUP => 'Chroot options', + DEFAULT => 0, + HELP => 'Try to remove all additional packages that are not strictly required for the build right after build dependencies were installed. This currently works best with the aspcud resolver. The apt resolver will not make as much effort to remove all unneeded packages and will keep all providers of a virtual package and all packages from any dependency alternative that happen to be installed. The aptitude and xapt resolver do not implement this feature yet. The removed packages are not yet added again after the build finished. This can have undesirable side effects like lintian not working (because there is no apt to install its dependencies) or bare chroots becoming totally unusable after apt was removed from them. Thus, this option should only be used with throw-away chroots like schroot provides them where the original state is automatically restored after each build.', + CLI_OPTIONS => ['--purge-extra-packages'] + } + ); + + $conf->set_allowed_keys(\%sbuild_keys); +} + +sub read ($) { + my $conf = shift; + + # Set here to allow user to override. + if (-t STDIN && -t STDOUT) { + $conf->_set_default('VERBOSE', 1); + } else { + $conf->_set_default('VERBOSE', 0); + } + + my $HOME = $conf->get('HOME'); + + my $files = ["$Sbuild::Sysconfig::paths{'SBUILD_CONF'}", + "$HOME/.sbuildrc"]; + + push @{$files}, $ENV{'SBUILD_CONFIG'} if defined $ENV{'SBUILD_CONFIG'}; + + # For compatibility only. Non-scalars are deprecated. + my $deprecated_init = <<END; +my \%mailto; +undef \%mailto; +my \@toolchain_regex; +undef \@toolchain_regex; +my \%individual_stalled_pkg_timeout; +undef \%individual_stalled_pkg_timeout; +END + + my $deprecated_setup = <<END; +# Non-scalar values, for backward compatibility. +if (\%mailto) { + warn 'W: \%mailto is deprecated; please use the hash reference \$mailto{}\n'; + \$conf->set('MAILTO_HASH', \\\%mailto); +} +if (\@toolchain_regex) { + warn 'W: \@toolchain_regex is deprecated; please use the array reference \$toolchain_regexp[]\n'; + \$conf->set('TOOLCHAIN_REGEX', \\\@toolchain_regex); +} +if (\%individual_stalled_pkg_timeout) { + warn 'W: \%individual_stalled_pkg_timeout is deprecated; please use the hash reference \$individual_stalled_pkg_timeout{}\n'; + \$conf->set('INDIVIDUAL_STALLED_PKG_TIMEOUT', + \\\%individual_stalled_pkg_timeout); +} +END + + my $custom_setup = <<END; +push(\@{\${\$conf->get('EXTERNAL_COMMANDS')}{"chroot-user-setup-commands"}}, +\$chroot_setup_script) if (\$chroot_setup_script); + + # Trigger log directory creation if needed + \$conf->get('LOG_DIR_AVAILABLE'); + +END + + + $conf->read($files, $deprecated_init, $deprecated_setup, + $custom_setup); +} + +1; diff --git a/lib/Sbuild/ConfBase.pm b/lib/Sbuild/ConfBase.pm new file mode 100644 index 0000000..2951238 --- /dev/null +++ b/lib/Sbuild/ConfBase.pm @@ -0,0 +1,548 @@ +# +# ConfBase.pm: configuration library (base functionality) for sbuild +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2006-2008 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::ConfBase; + +use strict; +use warnings; + +use Sbuild qw(isin); + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter); + + @EXPORT = qw(); +} + +sub init_allowed_keys { + my $self = shift; + + my $validate_program = sub { + my $self = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + my $program = $self->get($key); + + die "$key binary is not defined" + if !defined($program) || !$program; + + # Emulate execvp behaviour by searching the binary in the PATH. + my @paths = split(/:/, $self->get('PATH')); + # Also consider the empty path for absolute locations. + push (@paths, ''); + my $found = 0; + foreach my $path (@paths) { + $found = 1 if (-x File::Spec->catfile($path, $program)); + } + + die "$key binary '$program' does not exist or is not executable" + if !$found; + }; + + my $validate_directory = sub { + my $self = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + my $directory = $self->get($key); + + die "$key directory is not defined" + if !defined($directory); + + die "$key directory $directory does not exist" + if !-d $directory; + }; + + my $set_distribution = sub { + my $conf = shift; + my $entry = shift; + my $value = shift; + my $key = $entry->{'NAME'}; + $conf->_set_value($key, $value); + + $conf->set('MAILTO', + $conf->get('MAILTO_HASH')->{$value}) + if ($value && + $conf->get('DISTRIBUTION') && + $conf->get('MAILTO_HASH') && + $conf->get('MAILTO_HASH')->{$value}); + }; + + my @pwinfo = getpwuid($<); + die "Can't get passwd entry for uid $<: $!" if (!@pwinfo); + my $home = $ENV{'HOME'}; + if (!$home) { + print STDERR "W: HOME not set in environment; falling back to $pwinfo[7]\n"; + $home = $pwinfo[7]; + } + my $username = $pwinfo[0]; + my $fullname = $pwinfo[6]; + $fullname =~ s/,.*$//; + + chomp(my $hostname = `hostname -f`); + + # Not user-settable. + chomp(my $native_arch = + readpipe("dpkg --print-architecture")); + + my %common_keys = ( + 'PATH' => { + TYPE => 'STRING', + VARNAME => 'path', + GROUP => 'Build environment', + DEFAULT => "/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games", + HELP => 'PATH to set when running dpkg-buildpackage.', + CLI_OPTIONS => ['--use-snapshot'] + }, + 'DISTRIBUTION' => { + TYPE => 'STRING', + VARNAME => 'distribution', + GROUP => 'Build options', + DEFAULT => undef, + SET => $set_distribution, + HELP => 'Default distribution. By default, no distribution is defined, and the user must specify it with the -d option. However, a default may be configured here if desired. Users must take care not to upload to the wrong distribution when this option is set, for example experimental packages will be built for upload to unstable when this is not what is required.', + CLI_OPTIONS => ['-d', '--dist'] + }, + 'OVERRIDE_DISTRIBUTION' => { + TYPE => 'BOOL', + GROUP => '__INTERNAL', + DEFAULT => 0, + GET => sub { + my $conf = shift; + my $entry = shift; + + my $dist = $conf->get('DISTRIBUTION'); + + my $overridden = 0; + $overridden = 1 + if (defined($dist)); + + return $overridden; + }, + HELP => 'Default distribution has been overridden' + }, + 'MAILPROG' => { + TYPE => 'STRING', + VARNAME => 'mailprog', + GROUP => 'Programs', + CHECK => sub { + my $conf = shift; + my $entry = shift; + my $key = $entry->{'NAME'}; + + # Only validate if needed. + if ($conf->get('MAILTO')) { + $validate_program->($conf, $entry); + } + }, + DEFAULT => '/usr/sbin/sendmail', + HELP => 'Program to use to send mail' + }, + # TODO: Check if defaulted in code assuming undef + # ARCH is the native (build-system) architecture. Not used for host/build. + 'ARCH' => { + TYPE => 'STRING', + GROUP => '__INTERNAL', + DEFAULT => $native_arch, + HELP => 'Build architecture (Arch we are building on).' + }, + 'HOST_ARCH' => { + TYPE => 'STRING', + VARNAME => 'host_arch', + GROUP => 'Build options', + DEFAULT => $native_arch, + # the $native_arch is different depending on the machine where + # sbuild is built but arch:all packages must not differ depending on + # the architecture they are built on, so don't show the default for + # example config and man page generation + IGNORE_DEFAULT => 1, + HELP => 'Host architecture (Arch we are building for)', + CLI_OPTIONS => ['--arch', '--host'] + }, + 'BUILD_ARCH' => { + TYPE => 'STRING', + VARNAME => 'build_arch', + GROUP => 'Build options', + DEFAULT => $native_arch, + # the $native_arch is different depending on the machine where + # sbuild is built but arch:all packages must not differ depending on + # the architecture they are built on, so don't show the default for + # example config and man page generation + IGNORE_DEFAULT => 1, + HELP => 'Build architecture (Arch we are building on).', + CLI_OPTIONS => ['--arch', '--build'] + }, + 'HOSTNAME' => { + TYPE => 'STRING', + GROUP => '__INTERNAL', + DEFAULT => $hostname, + HELP => 'System hostname. Should not require setting.' + }, + 'HOME' => { + TYPE => 'STRING', + GROUP => '__INTERNAL', + DEFAULT => $home, + HELP => 'User\'s home directory. Should not require setting.' + }, + 'USERNAME' => { + TYPE => 'STRING', + GROUP => '__INTERNAL', + DEFAULT => $username, + HELP => 'User\'s username. Should not require setting.' + }, + 'FULLNAME' => { + TYPE => 'STRING', + GROUP => '__INTERNAL', + DEFAULT => $fullname, + HELP => 'User\'s full name. Should not require setting.' + }, + 'BUILD_USER' => { + TYPE => 'STRING', + VARNAME => 'build_user', + GROUP => 'Core options', + DEFAULT => $username, + IGNORE_DEFAULT => 1, # don't write the username into the config + HELP => 'Username used for running dpkg-buildpackage. By default the user running sbuild is used within the chroot as well but that might allow a process from within the chroot to break out of the chroot by attaching to a process running outside the chroot with eg. gdb and then becoming root inside the chroot through schroot and thus be able to leave the chroot.' + }, + 'VERBOSE' => { + TYPE => 'NUMERIC', + VARNAME => 'verbose', + GROUP => 'Logging options', + DEFAULT => undef, + GET => sub { + my $conf = shift; + my $entry = shift; + + my $retval = $conf->_get($entry->{'NAME'}); + + # Note that during a build, STDOUT is redirected, so + # this test will fail. So set explicitly at start to + # ensure correctness. + if (!defined($retval)) { + $retval = 0; + $retval = 1 if (-t STDIN && -t STDOUT); + } + + return $retval; + }, + HELP => 'Verbose logging level' + }, + 'DEBUG' => { + TYPE => 'NUMERIC', + VARNAME => 'debug', + GROUP => 'Logging options', + DEFAULT => 0, + HELP => 'Debug logging level' + }, + ); + + $self->set_allowed_keys(\%common_keys); +} + +sub new { + my $class = shift; + my %opts = @_; + + my $self = {}; + bless($self, $class); + + $self->{'CHECK'} = 1; + $self->{'CHECK'} = $opts{'CHECK'} if exists $opts{'CHECK'}; + + $self->init_allowed_keys(); + + return $self; +} + +sub get_keys { + my $self = shift; + + return keys(%{$self->{'KEYS'}}); +} + +sub is_default { + my $self = shift; + my $key = shift; + + return ($self->_get_value($key) == undef); +} + +sub _get_property_value { + my $self = shift; + my $key = shift; + my $property = shift; + + my $entry = $self->{'KEYS'}->{$key}; + + return $entry->{$property}; +} + +sub _get_value { + my $self = shift; + my $key = shift; + + return $self->_get_property_value($key, 'VALUE'); +} + +sub _get_default { + my $self = shift; + my $key = shift; + + return $self->_get_property_value($key, 'DEFAULT'); +} + +sub _get_type { + my $self = shift; + my $key = shift; + + return $self->_get_property_value($key, 'TYPE'); +} + +sub _get_varname { + my $self = shift; + my $key = shift; + + return $self->_get_property_value($key, 'VARNAME'); +} + +sub _get_group { + my $self = shift; + my $key = shift; + + return $self->_get_property_value($key, 'GROUP'); +} + +sub _get_help { + my $self = shift; + my $key = shift; + + return $self->_get_property_value($key, 'HELP'); +} + +sub _get_example { + my $self = shift; + my $key = shift; + + return $self->_get_property_value($key, 'EXAMPLE'); +} + +sub _get_ignore_default { + my $self = shift; + my $key = shift; + + return $self->_get_property_value($key, 'IGNORE_DEFAULT'); +} + +sub _get_cli_options { + my $self = shift; + my $key = shift; + + return $self->_get_property_value($key, 'CLI_OPTIONS'); +} + +sub _get { + my $self = shift; + my $key = shift; + + my $value = undef; + $value = $self->_get_value($key); + $value = $self->_get_default($key) + if (!defined($value)); + + return $value; +} + +sub get { + my $self = shift; + my $key = shift; + + my $entry = $self->{'KEYS'}->{$key}; + + my $value = undef; + if ($entry) { + if (defined($entry->{'GET'})) { + $value = $entry->{'GET'}->($self, $entry); + } else { + $value = $self->_get($key); + } + } + + return $value; +} + +sub _set_property_value { + my $self = shift; + my $key = shift; + my $property = shift; + my $value = shift; + + my $entry = $self->{'KEYS'}->{$key}; + + return $entry->{$property} = $value; +} + +sub _set_value { + my $self = shift; + my $key = shift; + my $value = shift; + + return $self->_set_property_value($key, 'VALUE', $value); +} + +sub _set_default { + my $self = shift; + my $key = shift; + my $value = shift; + + return $self->_set_property_value($key, 'DEFAULT', $value); +} + +sub set { + my $self = shift; + my $key = shift; + my $value = shift; + + # Set global debug level. + $Sbuild::debug_level = $value + if ($key eq 'DEBUG' && defined($value)); + + my $entry = $self->{'KEYS'}->{$key}; + + if (defined($entry)) { + if (defined($entry->{'SET'})) { + $value = $entry->{'SET'}->($self, $entry, $value); + } else { + $value = $self->_set_value($key, $value); + } + if ($self->{'CHECK'} && defined($entry->{'CHECK'})) { + $entry->{'CHECK'}->($self, $entry); + } + $entry->{'NAME'} = $key; + return $value; + } else { + warn "W: key \"$key\" is not allowed in configuration"; + return undef; + } +} + +sub set_allowed_keys { + my $self = shift; + my $allowed_keys = shift; + + foreach (keys %{$allowed_keys}) { + $allowed_keys->{$_}->{'NAME'} = $_; + $self->{'KEYS'}->{$_} = $allowed_keys->{$_} + } + +} + +sub check { + my $self = shift; + my $key = shift; + + my $entry = $self->{'KEYS'}->{$key}; + + if (defined($entry)) { + if ($self->{'CHECK'} && defined($entry->{'CHECK'})) { + $entry->{'CHECK'}->($self, $entry); + } + } +} + +sub warn_deprecated { + my $oldtype = shift; + my $oldopt = shift; + my $newtype = shift; + my $newopt = shift; + + warn "W: Obsolete $oldtype option '$oldopt' used in configuration"; + warn "I: The replacement is $newtype option '$newopt'" +} + +sub read ($$$$) { + my $conf = shift; + my $paths = shift; + my $deprecated_init = shift; + my $deprecated_setup = shift; + my $custom_setup = shift; + + foreach my $path (@{$paths}) { + $path = "'$path'"; + } + my $pathstring = join(", ", @{$paths}); + + my $HOME = $conf->get('HOME'); + + # Variables are undefined, so config will default to DEFAULT if unset. + + # Create script to source configuration. + my $script = "use strict;\nuse warnings;\n"; + my @keys = $conf->get_keys(); + foreach my $key (@keys) { + next if $conf->_get_group($key) =~ m/^__/; + + my $varname = $conf->_get_varname($key); + $script .= "my \$$varname = undef;\n"; + } + + # For compatibility only. Non-scalars are deprecated. + $script .= $deprecated_init + if ($deprecated_init); + + $script .= <<END; + +foreach ($pathstring) { + if (-r \$_) { + my \$e = eval `cat "\$_"`; + if (!defined(\$e)) { + print STDERR "E: \$_: Errors found in configuration file:\n\$\@"; + exit(1); + } + } +} + +# Needed before any program validation. +\$conf->set('PATH', \$path); +END + +# Non-scalar values, for backward compatibility. + $script .= $deprecated_setup + if ($deprecated_setup); + + foreach my $key (@keys) { + next if $conf->_get_group($key) =~ m/^__/; + + my $varname = $conf->_get_varname($key); + $script .= "\$conf->set('$key', \$$varname);\n"; + } + + $script .= $custom_setup + if ($custom_setup); + + + $script .= "return 1;\n"; + + eval $script or die "Error reading configuration: $@"; +} + +1; diff --git a/lib/Sbuild/Exception.pm b/lib/Sbuild/Exception.pm new file mode 100644 index 0000000..d35f194 --- /dev/null +++ b/lib/Sbuild/Exception.pm @@ -0,0 +1,34 @@ +# +# Exception.pm: exceptions for sbuild +# Copyright © 2011 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::Exception; + +use strict; +use warnings; + +use Exception::Class ( + 'Sbuild::Exception::Base', + + 'Sbuild::Exception::Build' => { isa => 'Sbuild::Exception::Base', + fields => [ 'info', 'status', 'failstage' ] } + + ); + +1; diff --git a/lib/Sbuild/LogBase.pm b/lib/Sbuild/LogBase.pm new file mode 100644 index 0000000..d3de8de --- /dev/null +++ b/lib/Sbuild/LogBase.pm @@ -0,0 +1,116 @@ +# +# LogBase.pm: logging library (base functionality) for sbuild +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2005-2009 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::LogBase; + +use strict; +use warnings; +use English; + +sub open_log ($$$); +sub close_log ($); + +our $log = undef; +our $saved_stdout = undef; +our $saved_stderr = undef; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT_OK); + + @ISA = qw(Exporter); + + @EXPORT_OK = qw(open_log close_log $log $saved_stdout $saved_stderr); +} + +sub open_log ($$$) { + my $conf = shift; + my $log_file = shift; # File to log to + my $logfunc = shift; # Function to handle logging + + if (!defined($logfunc)) { + $logfunc = sub { + my $log_file = shift; + my $message = shift; + + print $log_file $message; + } + } + + $log_file->autoflush(1) if defined($log_file); + + my $pid; + ($pid = open($log, "|-")); + if (!defined $pid) { + warn "Cannot open pipe to log: $!\n"; + } + elsif ($pid == 0) { + # We ignore SIG(INT|QUIT|TERM) because they will be caught in + # the parent which will subsequently close the logging stream + # resulting in our termination. This is needed to ensure the + # final log messages are sent and the parent doesn't die with + # SIGPIPE. + $SIG{'INT'} = 'IGNORE'; + $SIG{'QUIT'} = 'IGNORE'; + $SIG{'TERM'} = 'IGNORE'; + $PROGRAM_NAME = 'main log for ' . $PROGRAM_NAME; + while (<STDIN>) { + $logfunc->($log_file, $_) + if (!$conf->get('NOLOG') && defined($log_file)); + $logfunc->(\*STDOUT, $_) + if ($conf->get('VERBOSE')); + } + undef $log_file; + exit 0; + } + + undef $log_file; # Close in parent + $log->autoflush(1); # Automatically flush + select($log); # It's the default stream + + open($saved_stdout, ">&STDOUT") or warn "Can't redirect stdout\n"; + open($saved_stderr, ">&STDERR") or warn "Can't redirect stderr\n"; + open(STDOUT, '>&', $log) or warn "Can't redirect stdout\n"; + open(STDERR, '>&', $log) or warn "Can't redirect stderr\n"; + + return $log; +} + +sub close_log ($) { + my $conf = shift; + + # Note: It's imperative to close and reopen in the exact order in + # which we originally opened and reopened, or else we can deadlock + # in wait4 when closing the log stream due to waiting on the child + # forever. + open(STDERR, '>&', $saved_stderr) or warn "Can't redirect stderr\n" + if defined($saved_stderr); + open(STDOUT, '>&', $saved_stdout) or warn "Can't redirect stdout\n" + if defined($saved_stdout); + $saved_stderr->close(); + undef $saved_stderr; + $saved_stdout->close(); + undef $saved_stdout; + $log->close(); + undef $log; +} + +1; diff --git a/lib/Sbuild/Makefile.am b/lib/Sbuild/Makefile.am new file mode 100644 index 0000000..217181f --- /dev/null +++ b/lib/Sbuild/Makefile.am @@ -0,0 +1,62 @@ +# sbuild Makefile template +# +# +# Copyright © 2004-2007 Roger Leigh <rleigh@debian.org> +# +# sbuild 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 3 of the License, or +# (at your option) any later version. +# +# sbuild 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 +# <http://www.gnu.org/licenses/>. +# +##################################################################### + +include $(top_srcdir)/scripts/global.mk + +perlmodsbuilddir = $(perlmoddir)/Sbuild + +MODULES = \ + Base.pm \ + Build.pm \ + Chroot.pm \ + ChrootPlain.pm \ + ChrootRoot.pm \ + ChrootSchroot.pm \ + ChrootSudo.pm \ + ChrootAutopkgtest.pm \ + ChrootUnshare.pm \ + ChrootSetup.pm \ + ChrootInfo.pm \ + ChrootInfoSchroot.pm \ + ChrootInfoSudo.pm \ + ChrootInfoAutopkgtest.pm \ + ChrootInfoUnshare.pm \ + Exception.pm \ + ResolverBase.pm \ + AptitudeResolver.pm \ + AptResolver.pm \ + AspcudResolver.pm \ + XaptResolver.pm \ + NullResolver.pm \ + Resolver.pm \ + Conf.pm \ + ConfBase.pm \ + LogBase.pm \ + Options.pm \ + OptionsBase.pm \ + Utility.pm + +perlmodsbuild_DATA = \ + $(MODULES) \ + Sysconfig.pm + +EXTRA_DIST = \ + $(MODULES) diff --git a/lib/Sbuild/NullResolver.pm b/lib/Sbuild/NullResolver.pm new file mode 100644 index 0000000..3e2bf8c --- /dev/null +++ b/lib/Sbuild/NullResolver.pm @@ -0,0 +1,69 @@ +# ResolverBase.pm: build library for sbuild +# Copyright © 2018 Johannes Schauer Marin Rodrigues <josch@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::NullResolver; + +use strict; +use warnings; + +use Sbuild qw(debug copy); +use Sbuild::Base; +use Sbuild::ResolverBase; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::ResolverBase); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + my $session = shift; + my $host = shift; + + my $self = $class->SUPER::new($conf, $session, $host); + bless($self, $class); + + return $self; +} + +sub install_deps { + my $self = shift; + my $name = shift; + my @pkgs = @_; + + $self->log("Null resolver: not installing $name dependencies\n"); + + return 1; +} + +sub purge_extra_packages { + my $self = shift; + my $name = shift; + + $self->log("Null resolver: not removing $name dependencies\n"); + + return 1; +} + +1; diff --git a/lib/Sbuild/Options.pm b/lib/Sbuild/Options.pm new file mode 100644 index 0000000..8cc70dc --- /dev/null +++ b/lib/Sbuild/Options.pm @@ -0,0 +1,633 @@ +# +# Options.pm: options parser for sbuild +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2005-2006 Roger Leigh <rleigh@debian.org> +# Copyright © 2008 Simon McVittie <smcv@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::Options; + +use strict; +use warnings; + +use Sbuild::OptionsBase; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::OptionsBase); + + @EXPORT = qw(); +} + +sub set_options { + my $self = shift; + + my ($opt_arch_all, $opt_no_arch_all); + my ($opt_build_arch, $opt_host_arch, $opt_arch); + my ($opt_arch_any, $opt_no_arch_any); + my ($opt_source, $opt_no_source); + my ($opt_apt_clean, $opt_no_apt_clean, $opt_apt_update, $opt_no_apt_update, + $opt_apt_upgrade, $opt_no_apt_upgrade, $opt_apt_distupgrade, $opt_no_apt_distupgrade); + my ($opt_purge, $opt_purge_build, $opt_purge_deps, $opt_purge_session); + my ($opt_resolve_alternatives, $opt_no_resolve_alternatives); + my ($opt_clean_source, $opt_no_clean_source); + my ($opt_run_lintian, $opt_no_run_lintian); + my ($opt_run_piuparts, $opt_no_run_piuparts); + my ($opt_run_autopkgtest, $opt_no_run_autopkgtest); + my ($opt_make_binnmu, $opt_binnmu, $opt_binnmu_timestamp, $opt_binnmu_changelog, $opt_append_to_version); + + $self->add_options("arch=s" => sub { + if (defined $opt_arch && $opt_arch ne $_[1]) { + die "cannot specify differing --arch multiple times"; + } + if (defined $opt_build_arch && $opt_build_arch ne $_[1]) { + die "cannot specify --arch together with differing --build-arch"; + } + if (defined $opt_host_arch && $opt_host_arch ne $_[1]) { + die "cannot specify --arch together with differing --host-arch"; + } + $self->set_conf('HOST_ARCH', $_[1]); + $self->set_conf('BUILD_ARCH', $_[1]); + $opt_arch = $_[1]; + }, + "build=s" => sub { + if (defined $opt_build_arch && $opt_build_arch ne $_[1]) { + die "cannot specify differing --build-arch multiple times"; + } + if (defined $opt_arch && $opt_arch ne $_[1]) { + die "cannot specify --build-arch together with differing --arch"; + } + $self->set_conf('BUILD_ARCH', $_[1]); + $opt_build_arch = $_[1]; + }, + "host=s" => sub { + if (defined $opt_host_arch && $opt_host_arch ne $_[1]) { + die "cannot specify differing --host-arch multiple times"; + } + if (defined $opt_arch && $opt_arch ne $_[1]) { + die "cannot specify --host-arch together with differing --arch"; + } + $self->set_conf('HOST_ARCH', $_[1]); + $opt_host_arch = $_[1]; + }, + "A|arch-all" => sub { + if ($opt_no_arch_all) { + die "--arch-all cannot be used together with --no-arch-all"; + } + if ($opt_make_binnmu) { + die "--arch-all cannot be used together with --make-binNMU"; + } + if ($opt_append_to_version) { + die "--arch-all cannot be used together with --append-to-version"; + } + $self->set_conf('BUILD_ARCH_ALL', 1); + $opt_arch_all = 1; + }, + "no-arch-all" => sub { + if ($opt_arch_all) { + die "--no-arch-all cannot be used together with --arch-all"; + } + $self->set_conf('BUILD_ARCH_ALL', 0); + $opt_no_arch_all = 1; + }, + "arch-any" => sub { + if ($opt_no_arch_any) { + die "--arch-any cannot be used together with --no-arch-any"; + } + $self->set_conf('BUILD_ARCH_ANY', 1); + $opt_arch_any = 1; + }, + "no-arch-any" => sub { + if ($opt_arch_any) { + die "--no-arch-any cannot be used together with --arch-any"; + } + $self->set_conf('BUILD_ARCH_ANY', 0); + $opt_no_arch_any = 1; + }, + "profiles=s" => sub { + $_[1] =~ tr/,/ /; + $self->set_conf('BUILD_PROFILES', $_[1]); + }, + "add-depends=s" => sub { + push(@{$self->get_conf('MANUAL_DEPENDS')}, $_[1]); + }, + "add-conflicts=s" => sub { + push(@{$self->get_conf('MANUAL_CONFLICTS')}, $_[1]); + }, + "add-depends-arch=s" => sub { + push(@{$self->get_conf('MANUAL_DEPENDS_ARCH')}, $_[1]); + }, + "add-conflicts-arch=s" => sub { + push(@{$self->get_conf('MANUAL_CONFLICTS_ARCH')}, $_[1]); + }, + "add-depends-indep=s" => sub { + push(@{$self->get_conf('MANUAL_DEPENDS_INDEP')}, $_[1]); + }, + "add-conflicts-indep=s" => sub { + push(@{$self->get_conf('MANUAL_CONFLICTS_INDEP')}, $_[1]); + }, + "b|batch" => sub { + $self->set_conf('BATCH_MODE', 1); + }, + "make-binNMU=s" => sub { + if ($opt_binnmu_changelog) { + die "--make-binNMU cannot be used together with --binNMU-changelog"; + } + $self->set_conf('BIN_NMU', $_[1]); + $self->set_conf('BIN_NMU_VERSION', 1) + if (!defined $self->get_conf('BIN_NMU_VERSION')); + $opt_make_binnmu = 1; + $self->set_conf('BUILD_ARCH_ALL', 0); + }, + "binNMU=i" => sub { + if ($opt_binnmu_changelog) { + die "--binNMU cannot be used together with --binNMU-changelog"; + } + $self->set_conf('BIN_NMU_VERSION', $_[1]); + $opt_binnmu = 1; + }, + "binNMU-timestamp=s" => sub { + if ($opt_binnmu_changelog) { + die "--binNMU-timestamp cannot be used together with --binNMU-changelog"; + } + $self->set_conf('BIN_NMU_TIMESTAMP', $_[1]); + $opt_binnmu_timestamp = 1; + }, + "append-to-version=s" => sub { + if ($opt_binnmu_changelog) { + die "--append-to-version cannot be used together with --binNMU-changelog"; + } + $self->set_conf('APPEND_TO_VERSION', $_[1]); + $opt_append_to_version = 1; + $self->set_conf('BUILD_ARCH_ALL', 0); + }, + "binNMU-changelog=s" => sub { + if ($opt_make_binnmu) { + die "--binNMU-changelog cannot be used together with --make-binNMU"; + } + if ($opt_binnmu) { + die "--binNMU-changelog cannot be used together with --binNMU"; + } + if ($opt_binnmu_timestamp) { + die "--binNMU-changelog cannot be used together with --binNMU-timestamp"; + } + if ($opt_append_to_version) { + die "--binNMU-changelog cannot be used together with --append-to-version"; + } + $self->set_conf('BIN_NMU_CHANGELOG', $_[1]); + $opt_binnmu_changelog = 1; + }, + "build-dir=s" => sub { + $self->set_conf('BUILD_DIR', $_[1]); + }, + "c|chroot=s" => sub { + $self->set_conf('CHROOT', $_[1]); + }, + "chroot-mode=s" => sub { + $self->set_conf('CHROOT_MODE', $_[1]); + }, + "autopkgtest-virt-server=s" => sub { + $self->set_conf('AUTOPKGTEST_VIRT_SERVER', $_[1]); + }, + "autopkgtest-virt-server-opts=s" => sub { + push(@{$self->get_conf('AUTOPKGTEST_VIRT_SERVER_OPTIONS')}, + split(/\s+/, $_[1])); + }, + "autopkgtest-virt-server-opt=s" => sub { + push(@{$self->get_conf('AUTOPKGTEST_VIRT_SERVER_OPTIONS')}, $_[1]); + }, + "apt-clean" => sub { + if ($opt_no_apt_clean) { + die "--apt-clean cannot be used together with --no-apt-clean"; + } + $self->set_conf('APT_CLEAN', 1); + $opt_apt_clean = 1; + }, + "apt-update" => sub { + if ($opt_no_apt_update) { + die "--apt-update cannot be used together with --no-apt-update"; + } + $self->set_conf('APT_UPDATE', 1); + $opt_apt_update = 1; + }, + "apt-upgrade" => sub { + if ($opt_no_apt_upgrade) { + die "--apt-upgrade cannot be used together with --no-apt-upgrade"; + } + $self->set_conf('APT_UPGRADE', 1); + $opt_apt_upgrade = 1; + }, + "apt-distupgrade" => sub { + if ($opt_no_apt_distupgrade) { + die "--apt-distupgrade cannot be used together with --no-apt-distupgrade"; + } + $self->set_conf('APT_DISTUPGRADE', 1); + $opt_apt_distupgrade = 1; + }, + "no-apt-clean" => sub { + if ($opt_apt_clean) { + die "--no-apt-clean cannot be used together with --apt-clean"; + } + $self->set_conf('APT_CLEAN', 0); + $opt_no_apt_clean = 1; + }, + "no-apt-update" => sub { + if ($opt_apt_update) { + die "--no-apt-update cannot be used together with --apt-update"; + } + $self->set_conf('APT_UPDATE', 0); + $opt_no_apt_update = 1; + }, + "no-apt-upgrade" => sub { + if ($opt_apt_upgrade) { + die "--no-apt-upgrade cannot be used together with --apt-upgrade"; + } + $self->set_conf('APT_UPGRADE', 0); + $opt_no_apt_upgrade = 1; + }, + "no-apt-distupgrade" => sub { + if ($opt_apt_distupgrade) { + die "--no-apt-distupgrade cannot be used together with --apt-distupgrade"; + } + $self->set_conf('APT_DISTUPGRADE', 0); + $opt_no_apt_distupgrade = 1; + }, + "d|dist=s" => sub { + $self->set_conf('DISTRIBUTION', $_[1]); + $self->set_conf('DISTRIBUTION', "oldstable") + if $self->get_conf('DISTRIBUTION') eq "o"; + $self->set_conf('DISTRIBUTION', "stable") + if $self->get_conf('DISTRIBUTION') eq "s"; + $self->set_conf('DISTRIBUTION', "testing") + if $self->get_conf('DISTRIBUTION') eq "t"; + $self->set_conf('DISTRIBUTION', "unstable") + if $self->get_conf('DISTRIBUTION') eq "u"; + $self->set_conf('DISTRIBUTION', "experimental") + if $self->get_conf('DISTRIBUTION') eq "e"; + $self->set_conf('OVERRIDE_DISTRIBUTION', 1); + }, + "force-orig-source" => sub { + $self->set_conf('FORCE_ORIG_SOURCE', 1); + }, + "m|maintainer=s" => sub { + $self->set_conf('MAINTAINER_NAME', $_[1]); + }, + "mailfrom=s" => sub { + $self->set_conf('MAILFROM', $_[1]); + }, + "sbuild-mode=s" => sub { + $self->set_conf('SBUILD_MODE', $_[1]); + }, + "k|keyid=s" => sub { + $self->set_conf('KEY_ID', $_[1]); + }, + "e|uploader=s" => sub { + $self->set_conf('UPLOADER_NAME', $_[1]); + }, + "debbuildopts=s" => sub { + push(@{$self->get_conf('DPKG_BUILDPACKAGE_USER_OPTIONS')}, + split(/\s+/, $_[1])); + }, + "debbuildopt=s" => sub { + push(@{$self->get_conf('DPKG_BUILDPACKAGE_USER_OPTIONS')}, + $_[1]); + }, + "dpkg-file-suffix=s" => sub { + $self->set_conf('DPKG_FILE_SUFFIX', $_[1]); + }, + "j|jobs=i" => sub { + push(@{$self->get_conf('DPKG_BUILDPACKAGE_USER_OPTIONS')}, + '-j'.$_[1]) + }, + "dpkg-source-opts=s" => sub { + push(@{$self->get_conf('DPKG_SOURCE_OPTIONS')}, + split(/\s+/, $_[1])); + }, + "dpkg-source-opt=s" => sub { + push(@{$self->get_conf('DPKG_SOURCE_OPTIONS')}, + $_[1]); + }, + "mail-log-to=s" => sub { + $self->set_conf('MAILTO', $_[1]); + $self->set_conf('MAILTO_FORCED_BY_CLI', "yes"); + }, + "n|nolog" => sub { + $self->set_conf('NOLOG', 1); + }, + "p|purge=s" => sub { + if (defined $opt_purge_build) { + die "cannot specify --purge together with --purge-build"; + } + if (defined $opt_purge_deps) { + die "cannot specify --purge together with --purge-deps"; + } + if (defined $opt_purge_session) { + die "cannot specify --purge together with --purge-session"; + } + $self->set_conf('PURGE_BUILD_DEPS', $_[1]); + $self->set_conf('PURGE_BUILD_DIRECTORY', $_[1]); + $self->set_conf('PURGE_SESSION', $_[1]); + $opt_purge = 1; + }, + "purge-build=s" => sub { + if (defined $opt_purge) { + die "cannot specify --purge-build together with --purge"; + } + $self->set_conf('PURGE_BUILD_DIRECTORY', $_[1]); + $opt_purge_build = 1; + }, + "purge-deps=s" => sub { + if (defined $opt_purge) { + die "cannot specify --purge-deps together with --purge"; + } + $self->set_conf('PURGE_BUILD_DEPS', $_[1]); + $opt_purge_deps = 1; + }, + "purge-session=s" => sub { + if (defined $opt_purge) { + die "cannot specify --purge-session together with --purge"; + } + $self->set_conf('PURGE_SESSION', $_[1]); + $opt_purge_session = 1; + }, + "s|source" => sub { + if ($opt_no_source) { + die "--source cannot be used together with --no-source"; + } + $self->set_conf('BUILD_SOURCE', 1); + $opt_source = 1; + }, + "no-source" => sub { + if ($opt_source) { + die "--no-source cannot be used together with --source"; + } + $self->set_conf('BUILD_SOURCE', 0); + $opt_no_source = 1; + }, + "archive=s" => sub { + $self->set_conf('ARCHIVE', $_[1]); + }, + "stats-dir=s" => sub { + $self->set_conf('STATS_DIR', $_[1]); + }, + "setup-hook=s" => sub { + push(@{${$self->get_conf('EXTERNAL_COMMANDS')}{"chroot-setup-commands"}}, + $_[1]); + $self->set_conf('CHROOT_SETUP_SCRIPT', $_[1]); + }, + "use-snapshot" => sub { + my $newldpath = '/usr/lib/gcc-snapshot/lib'; + my $ldpath = $self->get_conf('LD_LIBRARY_PATH'); + if (defined($ldpath) && $ldpath ne '') { + $newldpath .= ':' . $ldpath; + } + + $self->set_conf('GCC_SNAPSHOT', 1); + $self->set_conf('LD_LIBRARY_PATH', $newldpath); + $self->set_conf('PATH', + '/usr/lib/gcc-snapshot/bin' . + $self->get_conf('PATH') ne '' ? ':' . $self->get_conf('PATH') : ''); + }, + "build-dep-resolver=s" => sub { + $self->set_conf('BUILD_DEP_RESOLVER', $_[1]); + }, + "aspcud-criteria=s" => sub { + $self->set_conf('ASPCUD_CRITERIA', $_[1]); + }, + "resolve-alternatives" => sub { + if ($opt_no_resolve_alternatives) { + die "--resolve-alternatives cannot be used together with --no-resolve-alternatives"; + } + $self->set_conf('RESOLVE_ALTERNATIVES', 1); + $opt_resolve_alternatives = 1; + }, + "no-resolve-alternatives" => sub { + if ($opt_resolve_alternatives) { + die "--no-resolve-alternatives cannot be used together with --resolve-alternatives"; + } + $self->set_conf('RESOLVE_ALTERNATIVES', 0); + $opt_no_resolve_alternatives = 1; + }, + "clean-source" => sub { + if ($opt_no_clean_source) { + die "--clean-source cannot be used together with --no-clean-source"; + } + $self->set_conf('CLEAN_SOURCE', 1); + $opt_clean_source = 1; + }, + "no-clean-source" => sub { + if ($opt_clean_source) { + die "--no-clean-source cannot be used together with --clean-source"; + } + $self->set_conf('CLEAN_SOURCE', 0); + $opt_no_clean_source = 1; + }, + "run-lintian" => sub { + if ($opt_no_run_lintian) { + die "--run-lintian cannot be used together with --no-run-lintian"; + } + $self->set_conf('RUN_LINTIAN', 1); + $opt_run_lintian = 1; + }, + "no-run-lintian" => sub { + if ($opt_run_lintian) { + die "--no-run-lintian cannot be used together with --run-lintian"; + } + $self->set_conf('RUN_LINTIAN', 0); + $opt_no_run_lintian = 1; + }, + "lintian-opts=s" => sub { + push(@{$self->get_conf('LINTIAN_OPTIONS')}, + split(/\s+/, $_[1])); + }, + "lintian-opt=s" => sub { + push(@{$self->get_conf('LINTIAN_OPTIONS')}, + $_[1]); + }, + "run-piuparts" => sub { + if ($opt_no_run_piuparts) { + die "--run-piuparts cannot be used together with --no-run-piuparts"; + } + $self->set_conf('RUN_PIUPARTS', 1); + $opt_run_piuparts = 1; + }, + "no-run-piuparts" => sub { + if ($opt_run_piuparts) { + die "--no-run-piuparts cannot be used together with --run-piuparts"; + } + $self->set_conf('RUN_PIUPARTS', 0); + $opt_no_run_piuparts = 1; + }, + "piuparts-opts=s" => sub { + push(@{$self->get_conf('PIUPARTS_OPTIONS')}, + split(/\s+/, $_[1])); + }, + "piuparts-opt=s" => sub { + push(@{$self->get_conf('PIUPARTS_OPTIONS')}, + $_[1]); + }, + "piuparts-root-args=s" => sub { + push(@{$self->get_conf('PIUPARTS_ROOT_ARGS')}, + split(/\s+/, $_[1])); + }, + "piuparts-root-arg=s" => sub { + push(@{$self->get_conf('PIUPARTS_ROOT_ARGS')}, + $_[1]); + }, + "run-autopkgtest" => sub { + if ($opt_no_run_autopkgtest) { + die "--run-autopkgtest cannot be used together with --no-run-autopkgtest"; + } + $self->set_conf('RUN_AUTOPKGTEST', 1); + $opt_run_autopkgtest = 1; + }, + "no-run-autopkgtest" => sub { + if ($opt_run_autopkgtest) { + die "--no-run-autopkgtest cannot be used together with --run-autopkgtest"; + } + $self->set_conf('RUN_AUTOPKGTEST', 0); + $opt_no_run_autopkgtest = 1; + }, + "autopkgtest-opts=s" => sub { + push(@{$self->get_conf('AUTOPKGTEST_OPTIONS')}, + split(/\s+/, $_[1])); + }, + "autopkgtest-opt=s" => sub { + push(@{$self->get_conf('AUTOPKGTEST_OPTIONS')}, + $_[1]); + }, + "autopkgtest-root-args=s" => sub { + # special handling of the case when the string + # argument is the empty string. In that case, the + # empty string is appended. The split function + # would just return an empty list when splitting + # the empty string + if ($_[1] eq '') { + push(@{$self->get_conf('AUTOPKGTEST_ROOT_ARGS')}, + ''); + } else { + push(@{$self->get_conf('AUTOPKGTEST_ROOT_ARGS')}, + split(/\s+/, $_[1])); + } + }, + "autopkgtest-root-arg=s" => sub { + push(@{$self->get_conf('AUTOPKGTEST_ROOT_ARGS')}, + $_[1]); + }, + "pre-build-commands=s" => sub { + push(@{${$self->get_conf('EXTERNAL_COMMANDS')}{"pre-build-commands"}}, + $_[1]); + }, + "chroot-setup-commands=s" => sub { + push(@{${$self->get_conf('EXTERNAL_COMMANDS')}{"chroot-setup-commands"}}, + $_[1]); + }, + "chroot-update-failed-commands=s" => sub { + push(@{${$self->get_conf('EXTERNAL_COMMANDS')}{"chroot-update-failed-commands"}}, + $_[1]); + }, + "build-deps-failed-commands=s" => sub { + push(@{${$self->get_conf('EXTERNAL_COMMANDS')}{"build-deps-failed-commands"}}, + $_[1]); + }, + "build-failed-commands=s" => sub { + push(@{${$self->get_conf('EXTERNAL_COMMANDS')}{"build-failed-commands"}}, + $_[1]); + }, + "anything-failed-commands=s" => sub { + + # --anything-failed-commands simply triggers all the + # --xxx-failed-commands I know about + + push(@{${$self->get_conf('EXTERNAL_COMMANDS')}{"chroot-update-failed-commands"}}, + $_[1]); + push(@{${$self->get_conf('EXTERNAL_COMMANDS')}{"build-deps-failed-commands"}}, + $_[1]); + push(@{${$self->get_conf('EXTERNAL_COMMANDS')}{"build-failed-commands"}}, + $_[1]); + }, + "starting-build-commands=s" => sub { + push(@{${$self->get_conf('EXTERNAL_COMMANDS')}{"starting-build-commands"}}, + $_[1]); + }, + "finished-build-commands=s" => sub { + push(@{${$self->get_conf('EXTERNAL_COMMANDS')}{"finished-build-commands"}}, + $_[1]); + }, + "chroot-cleanup-commands=s" => sub { + push(@{${$self->get_conf('EXTERNAL_COMMANDS')}{"chroot-cleanup-commands"}}, + $_[1]); + }, + "post-build-commands=s" => sub { + push(@{${$self->get_conf('EXTERNAL_COMMANDS')}{"post-build-commands"}}, + $_[1]); + }, + "post-build-failed-commands=s" => sub { + push(@{${$self->get_conf('EXTERNAL_COMMANDS')}{"post-build-failed-commands"}}, + $_[1]); + }, + "log-external-command-output" => sub { + $self->set_conf('LOG_EXTERNAL_COMMAND_OUTPUT', 1); + }, + "log-external-command-error" => sub { + $self->set_conf('LOG_EXTERNAL_COMMAND_ERROR', 1); + }, + "extra-package=s" => sub { + push(@{$self->get_conf('EXTRA_PACKAGES')}, $_[1]); + }, + "extra-repository=s" => sub { + push(@{$self->get_conf('EXTRA_REPOSITORIES')}, $_[1]); + }, + "extra-repository-key=s" => sub { + push(@{$self->get_conf('EXTRA_REPOSITORY_KEYS')}, $_[1]); + }, + "build-path=s" => sub { + $self->set_conf('BUILD_PATH', $_[1]); + }, + "dsc-dir=s" => sub { + $self->set_conf('DSC_DIR', $_[1]); + }, + "source-only-changes" => sub { + $self->set_conf('SOURCE_ONLY_CHANGES', 1); + }, + "no-source-only-changes" => sub { + $self->set_conf('SOURCE_ONLY_CHANGES', 0); + }, + "purge-extra-packages" => sub { + $self->set_conf('PURGE_EXTRA_PACKAGES', 1); + }, + "bd-uninstallable-explainer=s" => sub { + $self->set_conf('BD_UNINSTALLABLE_EXPLAINER', $_[1]); + } + ); +} + +=pod +This function allows to extrapolate from the parsed and set options some +expected behaviours. +=cut +sub extrapolate_options { + my $self = shift; + + # This allows to pass -sa to all commands instead of passing it just to dpkg-buildpackage + push (@{$self->get_conf('DPKG_BUILDPACKAGE_USER_OPTIONS')}, "-sa") if ($self->get_conf('BUILD_SOURCE') && $self->get_conf('FORCE_ORIG_SOURCE')); +} + +1; diff --git a/lib/Sbuild/OptionsBase.pm b/lib/Sbuild/OptionsBase.pm new file mode 100644 index 0000000..d9b801b --- /dev/null +++ b/lib/Sbuild/OptionsBase.pm @@ -0,0 +1,102 @@ +# +# OptionsBase.pm: options parser (base functionality) for sbuild +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2005-2009 Roger Leigh <rleigh@debian.org> +# Copyright © 2008 Simon McVittie <smcv@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::OptionsBase; + +use strict; +use warnings; + +use Getopt::Long qw(:config no_ignore_case auto_abbrev gnu_getopt); +use Sbuild qw(help_text version_text usage_error); +use Sbuild::Base; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::Base); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + my $program = shift; + my $section = shift; + + my $self = $class->SUPER::new($conf); + bless($self, $class); + + $self->add_options("h|help" => sub { help_text($section, $program); }, + "V|version" => sub {version_text($program); }, + "D|debug" => sub { + $self->set_conf('DEBUG', + $self->get_conf('DEBUG') + 1); }, + "v|verbose" => sub { + $self->set_conf('VERBOSE', + $self->get_conf('VERBOSE') + 1); + }, + "q|quiet" => sub { + $self->set_conf('VERBOSE', + $self->get_conf('VERBOSE') - 1) + if $self->get_conf('VERBOSE'); + }); + + $self->set_options(); + + if (!$self->parse_options()) { + usage_error($program, "Error parsing command-line options"); + return undef; + } + $self->extrapolate_options(); + return $self; +} + +sub add_options () { + my $self = shift; + my @newopts = @_; + + my %options; + if (defined($self->get('Options'))) { + %options = (%{$self->get('Options')}, @newopts); + } else { + %options = (@newopts); + } + $self->set('Options', \%options); +} + +sub set_options () { + my $self = shift; +} + +sub extrapolate_options () { + my $self = shift; +} + +sub parse_options { + my $self = shift; + + return GetOptions((%{$self->get('Options')})); +} + +1; diff --git a/lib/Sbuild/Resolver.pm b/lib/Sbuild/Resolver.pm new file mode 100644 index 0000000..d811fa9 --- /dev/null +++ b/lib/Sbuild/Resolver.pm @@ -0,0 +1,66 @@ +# +# Resolver.pm: library for sbuild +# Copyright © 2010 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::Resolver; + +use Sbuild::AptResolver; +use Sbuild::XaptResolver; +use Sbuild::AptitudeResolver; +use Sbuild::AspcudResolver; +use Sbuild::NullResolver; + +use strict; +use warnings; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter); + + @EXPORT = qw(get_resolver); +} + +sub get_resolver ($$$); + +sub get_resolver ($$$) { + my $conf = shift; + my $session = shift; + my $host = shift; + + my $resolver; + if ($conf->get('BUILD_DEP_RESOLVER') eq "apt") { + $resolver = Sbuild::AptResolver->new($conf, $session, $host); + } elsif ($conf->get('BUILD_DEP_RESOLVER') eq "xapt") { + $resolver = Sbuild::XaptResolver->new($conf, $session, $host); + } elsif ($conf->get('BUILD_DEP_RESOLVER') eq "aptitude") { + $resolver = Sbuild::AptitudeResolver->new($conf, $session, $host); + } elsif ($conf->get('BUILD_DEP_RESOLVER') eq "aspcud") { + $resolver = Sbuild::AspcudResolver->new($conf, $session, $host); + } elsif ($conf->get('BUILD_DEP_RESOLVER') eq "null") { + $resolver = Sbuild::NullResolver->new($conf, $session, $host); + } else { + $resolver = Sbuild::AptResolver->new($conf, $session, $host); + } + + return $resolver; +} + +1; diff --git a/lib/Sbuild/ResolverBase.pm b/lib/Sbuild/ResolverBase.pm new file mode 100644 index 0000000..dff1905 --- /dev/null +++ b/lib/Sbuild/ResolverBase.pm @@ -0,0 +1,1685 @@ +# Resolver.pm: build library for sbuild +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2005-2010 Roger Leigh <rleigh@debian.org> +# Copyright © 2008 Simon McVittie <smcv@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::ResolverBase; + +use strict; +use warnings; +use POSIX; +use Fcntl; +use File::Temp qw(mktemp); +use File::Basename qw(basename); +use File::Copy; +use MIME::Base64; + +use Dpkg::Deps; +use Sbuild::Base; +use Sbuild qw(isin debug debug2); + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::Base); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + my $session = shift; + my $host = shift; + + my $self = $class->SUPER::new($conf); + bless($self, $class); + + $self->set('Session', $session); + $self->set('Host', $host); + $self->set('Changes', {}); + $self->set('AptDependencies', {}); + $self->set('Split', $self->get_conf('CHROOT_SPLIT')); + # Typically set by Sbuild::Build, but not outside a build context. + $self->set('Host Arch', $self->get_conf('HOST_ARCH')); + $self->set('Build Arch', $self->get_conf('BUILD_ARCH')); + $self->set('Build Profiles', $self->get_conf('BUILD_PROFILES')); + $self->set('Multiarch Support', 1); + $self->set('Initial Foreign Arches', {}); + $self->set('Added Foreign Arches', {}); + + my $dummy_archive_list_file = + '/etc/apt/sources.list.d/sbuild-build-depends-archive.list'; + $self->set('Dummy archive list file', $dummy_archive_list_file); + + my $extra_repositories_archive_list_file = + '/etc/apt/sources.list.d/sbuild-extra-repositories.list'; + $self->set('Extra repositories archive list file', $extra_repositories_archive_list_file); + + my $extra_packages_archive_list_file = + '/etc/apt/sources.list.d/sbuild-extra-packages-archive.list'; + $self->set('Extra packages archive list file', $extra_packages_archive_list_file); + + return $self; +} + +sub add_extra_repositories { + my $self = shift; + my $session = $self->get('Session'); + + # Add specified extra repositories into /etc/apt/sources.list.d/. + # This has to be done this early so that the early apt + # update/upgrade/distupgrade steps also consider the extra repositories. + # If this step would be done too late, extra repositories would only be + # considered when resolving build dependencies but not for upgrading the + # base chroot. + if (scalar @{$self->get_conf('EXTRA_REPOSITORIES')} > 0) { + my $extra_repositories_archive_list_file = $self->get('Extra repositories archive list file'); + if ($session->test_regular_file($extra_repositories_archive_list_file)) { + $self->log_error("$extra_repositories_archive_list_file exists - will not write extra repositories to it\n"); + } else { + my $tmpfilename = $session->mktemp(); + + my $tmpfh = $session->get_write_file_handle($tmpfilename); + if (!$tmpfh) { + $self->log_error("Cannot open pipe: $!\n"); + return 0; + } + for my $repospec (@{$self->get_conf('EXTRA_REPOSITORIES')}) { + print $tmpfh "$repospec\n"; + } + close $tmpfh; + # List file needs to be moved with root. + if (!$session->chmod($tmpfilename, '0644')) { + $self->log("Failed to create apt list file for dummy archive.\n"); + $session->unlink($tmpfilename); + return 0; + } + if (!$session->rename($tmpfilename, $extra_repositories_archive_list_file)) { + $self->log("Failed to create apt list file for dummy archive.\n"); + $session->unlink($tmpfilename); + return 0; + } + } + } +} + +sub setup { + my $self = shift; + + my $session = $self->get('Session'); + my $chroot_dir = $session->get('Location'); + + #Set up dpkg config + $self->setup_dpkg(); + + my $aptconf = "/var/lib/sbuild/apt.conf"; + $self->set('APT Conf', $aptconf); + + my $chroot_aptconf = $session->get('Location') . "/$aptconf"; + $self->set('Chroot APT Conf', $chroot_aptconf); + + my $tmpaptconf = $session->mktemp({ TEMPLATE => "$aptconf.XXXXXX"}); + if (!$tmpaptconf) { + $self->log_error("Can't create $chroot_aptconf.XXXXXX: $!\n"); + return 0; + } + + my $F = $session->get_write_file_handle($tmpaptconf); + if (!$F) { + $self->log_error("Cannot open pipe: $!\n"); + return 0; + } + + # Always write out apt.conf, because it may become outdated. + if ($self->get_conf('APT_ALLOW_UNAUTHENTICATED')) { + print $F qq(APT::Get::AllowUnauthenticated "true";\n); + } + print $F qq(APT::Install-Recommends "false";\n); + print $F qq(APT::AutoRemove::SuggestsImportant "false";\n); + print $F qq(APT::AutoRemove::RecommendsImportant "false";\n); + print $F qq(Acquire::Languages "none";\n); # do not download translations + + if ($self->get_conf('APT_KEEP_DOWNLOADED_PACKAGES')) { + print $F qq(APT::Keep-Downloaded-Packages "true";\n); + } else { + # remove packages from /var/cache/apt/archive/*.deb after installation + print $F qq(APT::Keep-Downloaded-Packages "false";\n); + } + + if ($self->get('Split')) { + print $F "Dir \"$chroot_dir\";\n"; + } + + close $F; + + if (!$session->rename($tmpaptconf, $aptconf)) { + $self->log_error("Can't rename $tmpaptconf to $aptconf: $!\n"); + return 0; + } + + if (!$session->chown($aptconf, $self->get_conf('BUILD_USER'), 'sbuild')) { + $self->log_error("Failed to set " . $self->get_conf('BUILD_USER') . + ":sbuild ownership on apt.conf at $aptconf\n"); + return 0; + } + if (!$session->chmod($aptconf, '0664')) { + $self->log_error("Failed to set 0664 permissions on apt.conf at $aptconf\n"); + return 0; + } + + # unsplit mode uses an absolute path inside the chroot, rather + # than on the host system. + if ($self->get('Split')) { + $self->set('APT Options', + ['-o', "Dir::State::status=$chroot_dir/var/lib/dpkg/status", + '-o', "DPkg::Options::=--root=$chroot_dir", + '-o', "DPkg::Run-Directory=$chroot_dir"]); + + $self->set('Aptitude Options', + ['-o', "Dir::State::status=$chroot_dir/var/lib/dpkg/status", + '-o', "DPkg::Options::=--root=$chroot_dir", + '-o', "DPkg::Run-Directory=$chroot_dir"]); + + # sudo uses an absolute path on the host system. + $session->get('Defaults')->{'ENV'}->{'APT_CONFIG'} = + $self->get('Chroot APT Conf'); + } else { # no split + $self->set('APT Options', []); + $self->set('Aptitude Options', []); + $session->get('Defaults')->{'ENV'}->{'APT_CONFIG'} = + $self->get('APT Conf'); + } + + $self->add_extra_repositories(); + + # Create an internal repository for packages given via --extra-package + # If this step would be done too late, extra packages would only be + # considered when resolving build dependencies but not for upgrading the + # base chroot. + if (scalar @{$self->get_conf('EXTRA_PACKAGES')} > 0) { + my $extra_packages_archive_list_file = $self->get('Extra packages archive list file'); + if ($session->test_regular_file($extra_packages_archive_list_file)) { + $self->log_error("$extra_packages_archive_list_file exists - will not write extra packages archive list to it\n"); + } else { + #Prepare a path to place the extra packages + if (! defined $self->get('Extra packages path')) { + my $tmpdir = $session->mktemp({ TEMPLATE => $self->get('Build Dir') . '/resolver-XXXXXX', DIRECTORY => 1}); + if (!$tmpdir) { + $self->log_error("mktemp -d " . $self->get('Build Dir') . '/resolver-XXXXXX failed\n'); + return 0; + } + $self->set('Extra packages path', $tmpdir); + } + if (!$session->chown($self->get('Extra packages path'), $self->get_conf('BUILD_USER'), 'sbuild')) { + $self->log_error("Failed to set " . $self->get_conf('BUILD_USER') . + ":sbuild ownership on extra packages dir\n"); + return 0; + } + if (!$session->chmod($self->get('Extra packages path'), '0770')) { + $self->log_error("Failed to set 0770 permissions on extra packages dir\n"); + return 0; + } + my $extra_packages_dir = $self->get('Extra packages path'); + my $extra_packages_archive_dir = $extra_packages_dir . '/apt_archive'; + my $extra_packages_release_file = $extra_packages_archive_dir . '/Release'; + + $self->set('Extra packages archive directory', $extra_packages_archive_dir); + $self->set('Extra packages release file', $extra_packages_release_file); + my $extra_packages_archive_list_file = $self->get('Extra packages archive list file'); + + if (!$session->test_directory($extra_packages_dir)) { + $self->log_warning('Could not create build-depends extra packages dir ' . $extra_packages_dir . ': ' . $!); + return 0; + } + if (!($session->test_directory($extra_packages_archive_dir) || $session->mkdir($extra_packages_archive_dir, { MODE => "00775"}))) { + $self->log_warning('Could not create build-depends extra packages archive dir ' . $extra_packages_archive_dir . ': ' . $!); + return 0; + } + + # Copy over all the extra binary packages from the host into the + # chroot + for my $deb (@{$self->get_conf('EXTRA_PACKAGES')}) { + if (-f $deb) { + my $base_deb = basename($deb); + if ($session->test_regular_file("$extra_packages_archive_dir/$base_deb")) { + $self->log_warning("$base_deb already exists in $extra_packages_archive_dir inside the chroot. Skipping...\n"); + next; + } + $self->log("Copying $deb to " . $session->get('Location') . "...\n"); + $session->copy_to_chroot($deb, $extra_packages_archive_dir); + } elsif (-d $deb) { + opendir(D, $deb); + while (my $f = readdir(D)) { + next if (! -f "$deb/$f"); + next if ("$deb/$f" !~ /\.deb$/); + if ($session->test_regular_file("$extra_packages_archive_dir/$f")) { + $self->log_warning("$f already exists in $extra_packages_archive_dir inside the chroot. Skipping...\n"); + next; + } + $self->log("Copying $deb/$f to " . $session->get('Location') . "...\n"); + $session->copy_to_chroot("$deb/$f", $extra_packages_archive_dir); + } + closedir(D); + } else { + $self->log_warning("$deb is neither a regular file nor a directory. Skipping...\n"); + } + } + + # Do code to run apt-ftparchive + if (!$self->run_apt_ftparchive($self->get('Extra packages archive directory'))) { + $self->log("Failed to run apt-ftparchive.\n"); + return 0; + } + + # Write a list file for the extra packages archive if one not create yet. + if (!$session->test_regular_file($extra_packages_archive_list_file)) { + my $tmpfilename = $session->mktemp(); + + if (!$tmpfilename) { + $self->log_error("Can't create tempfile\n"); + return 0; + } + + my $tmpfh = $session->get_write_file_handle($tmpfilename); + if (!$tmpfh) { + $self->log_error("Cannot open pipe: $!\n"); + return 0; + } + + # We always trust the extra packages apt repositories. + print $tmpfh 'deb [trusted=yes] file://' . $extra_packages_archive_dir . " ./\n"; + print $tmpfh 'deb-src [trusted=yes] file://' . $extra_packages_archive_dir . " ./\n"; + + close($tmpfh); + # List file needs to be moved with root. + if (!$session->chmod($tmpfilename, '0644')) { + $self->log("Failed to create apt list file for extra packages archive.\n"); + $session->unlink($tmpfilename); + return 0; + } + if (!$session->rename($tmpfilename, $extra_packages_archive_list_file)) { + $self->log("Failed to create apt list file for extra packages archive.\n"); + $session->unlink($tmpfilename); + return 0; + } + } + + } + } + + # Now, we'll add in any provided OpenPGP keys into the archive, so that + # builds can (optionally) trust an external key for the duration of the + # build. + # + # Keys have to be in a format that apt expects to land in + # /etc/apt/trusted.gpg.d as they are just copied to there. We could also + # support more formats by first importing them using gpg and then + # exporting them but that would require gpg to be installed inside the + # chroot. + if (@{$self->get_conf('EXTRA_REPOSITORY_KEYS')}) { + my $host = $self->get('Host'); + # remember whether running gpg worked or not + my $has_gpg = 1; + for my $repokey (@{$self->get_conf('EXTRA_REPOSITORY_KEYS')}) { + debug("Adding archive key: $repokey\n"); + if (!-f $repokey) { + $self->log("Failed to add archive key '${repokey}' - it doesn't exist!\n"); + return 0; + } + # key might be armored but apt requires keys in binary format + # We first try to run gpg from the host to convert the key into + # binary format (this works even when the key already is in binary + # format). + my $tmpfilename = mktemp("/tmp/tmp.XXXXXXXXXX"); + if ($has_gpg == 1) { + $host->run_command({ + COMMAND => ['gpg', '--yes', '--batch', '--output', $tmpfilename, '--dearmor', $repokey], + USER => $self->get_conf('BUILD_USER'), + }); + if ($?) { + # don't try to use gpg again in later loop iterations + $has_gpg = 0; + } + } + # If that doesn't work, then we manually convert the key + # as it is just base64 encoded data with a header and footer. + # + # The decoding of armored gpg keys can even be done from a shell + # script by using: + # + # awk '/^$/{ x = 1; } /^[^=-]/{ if (x) { print $0; } ; }' | base64 -d + # + # As explained by dkg here: https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=831409#67 + if ($has_gpg == 0) { + # Test if we actually have an armored key. Otherwise, no + # conversion is needed. + open my $fh, '<', $repokey; + read $fh, my $first_line, 36; + if ($first_line eq "-----BEGIN PGP PUBLIC KEY BLOCK-----") { + # Read the remaining part of the line until the newline. + # We do it like this because the line might contain + # additional whitespace characters or \r\n newlines. + <$fh>; + open my $out, '>', $tmpfilename; + # the file is an armored gpg key, so we convert it to the + # binary format + my $header = 1; + while( my $line = <$fh>) { + chomp $line; + # an empty line marks the end of the header + if ($line eq "") { + $header = 0; + next; + } + if ($header == 1) { + next; + } + # the footer might contain lines starting with an + # equal sign or minuses + if ($line =~ /^[=-]/) { + last; + } + print $out (decode_base64($line)); + } + close $out; + } + close $fh; + } + # we could use incrementing integers to number the extra + # repository keys but mktemp will also make sure that the new name + # doesn't exist yet and avoids the complexity of an additional + # variable + my $keyfilename = $session->mktemp({TEMPLATE => "/etc/apt/trusted.gpg.d/sbuild-extra-repository-XXXXXXXXXX.gpg"}); + if (!$keyfilename) { + $self->log_error("Can't create tempfile for external repository key\n"); + $session->unlink($keyfilename); + unlink $tmpfilename; + return 0; + } + if (!$session->copy_to_chroot($tmpfilename, $keyfilename)) { + $self->log_error("Failed to copy external repository key $repokey into chroot $keyfilename\n"); + $session->unlink($keyfilename); + unlink $tmpfilename; + return 0; + } + unlink $tmpfilename; + if (!$session->chmod($keyfilename, '0644')) { + $self->log_error("Failed to chmod $keyfilename inside the chroot\n"); + $session->unlink($keyfilename); + return 0; + } + } + + } + + # We have to do this early so that we can setup log filtering for the RESOLVERDIR + # We only set it up, if 'Build Dir' was set. It is not when the resolver + # is used by sbuild-createchroot, for example. + #Prepare a path to build a dummy package containing our deps: + if (! defined $self->get('Dummy package path') && defined $self->get('Build Dir')) { + my $tmpdir = $session->mktemp({ TEMPLATE => $self->get('Build Dir') . '/resolver-XXXXXX', DIRECTORY => 1}); + if (!$tmpdir) { + $self->log_error("mktemp -d " . $self->get('Build Dir') . '/resolver-XXXXXX failed\n'); + return 0; + } + $self->set('Dummy package path', $tmpdir); + } + + return 1; +} + +sub get_foreign_architectures { + my $self = shift; + + my $session = $self->get('Session'); + + $session->run_command({ COMMAND => ['dpkg', '--assert-multi-arch'], + USER => 'root'}); + if ($?) + { + $self->set('Multiarch Support', 0); + $self->log_error("dpkg does not support multi-arch\n"); + return {}; + } + + my $foreignarchs = $session->read_command({ COMMAND => ['dpkg', '--print-foreign-architectures'], USER => 'root' }); + + if (!defined($foreignarchs)) { + $self->set('Multiarch Support', 0); + $self->log_error("dpkg does not support multi-arch\n"); + return {}; + } + + if (!$foreignarchs) + { + debug("There are no foreign architectures configured\n"); + return {}; + } + + my %set; + foreach my $arch (split /\s+/, $foreignarchs) { + chomp $arch; + next unless $arch; + $set{$arch} = 1; + } + + return \%set; +} + +sub add_foreign_architecture { + + my $self = shift; + my $arch = shift; + + # just skip if dpkg is to old for multiarch + if (! $self->get('Multiarch Support')) { + debug("not adding $arch because of no multiarch support\n"); + return 1; + }; + + # if we already have this architecture, we're done + if ($self->get('Initial Foreign Arches')->{$arch}) { + debug("not adding $arch because it is an initial arch\n"); + return 1; + } + if ($self->get('Added Foreign Arches')->{$arch}) { + debug("not adding $arch because it has already been aded"); + return 1; + } + + my $session = $self->get('Session'); + + # FIXME - allow for more than one foreign arch + $session->run_command( + # This is the Ubuntu dpkg 1.16.0~ubuntuN interface; + # we ought to check (or configure) which to use with + # check_dpkg_version: + # { COMMAND => ['sh', '-c', 'echo "foreign-architecture ' . $self->get('Host Arch') . '" > /etc/dpkg/dpkg.cfg.d/sbuild'], + # USER => 'root' }); + # This is the Debian dpkg >= 1.16.2 interface: + { COMMAND => ['dpkg', '--add-architecture', $arch], + USER => 'root' }); + if ($?) + { + $self->log_error("Failed to set dpkg foreign-architecture config\n"); + return 0; + } + debug("Added foreign arch: $arch\n") if $arch; + + $self->get('Added Foreign Arches')->{$arch} = 1; + return 1; +} + +sub cleanup_foreign_architectures { + my $self = shift; + + # just skip if dpkg is to old for multiarch + if (! $self->get('Multiarch Support')) { return 1 }; + + my $added_foreign_arches = $self->get('Added Foreign Arches'); + + my $session = $self->get('Session'); + + if (defined ($session->get('Session Purged')) && $session->get('Session Purged') == 1) { + debug("Not removing foreign architectures: cloned chroot in use\n"); + return; + } + + foreach my $arch (keys %{$added_foreign_arches}) { + $self->log("Removing foreign architecture $arch\n"); + $session->run_command({ COMMAND => ['dpkg', '--remove-architecture', $arch], + USER => 'root', + DIR => '/'}); + if ($?) + { + $self->log_error("Failed to remove dpkg foreign-architecture $arch\n"); + return; + } + } +} + +sub setup_dpkg { + my $self = shift; + + my $session = $self->get('Session'); + + # Record initial foreign arch state so it can be restored + $self->set('Initial Foreign Arches', $self->get_foreign_architectures()); + + if ($self->get('Host Arch') ne $self->get('Build Arch')) { + $self->add_foreign_architecture($self->get('Host Arch')) + } +} + +sub cleanup { + my $self = shift; + + #cleanup dpkg cross-config + # rm /etc/dpkg/dpkg.cfg.d/sbuild + $self->cleanup_apt_archive(); + $self->cleanup_foreign_architectures(); +} + +sub update { + my $self = shift; + + $self->run_apt_command( + { COMMAND => [$self->get_conf('APT_GET'), 'update'], + ENV => {'DEBIAN_FRONTEND' => 'noninteractive'}, + USER => 'root', + DIR => '/' }); + return $?; +} + +sub update_archive { + my $self = shift; + + if (!$self->get_conf('APT_UPDATE_ARCHIVE_ONLY')) { + # Update with apt-get; causes complete archive update + $self->run_apt_command( + { COMMAND => [$self->get_conf('APT_GET'), 'update'], + ENV => {'DEBIAN_FRONTEND' => 'noninteractive'}, + USER => 'root', + DIR => '/' }); + } else { + my $session = $self->get('Session'); + # Create an empty sources.list.d directory that we can set as + # Dir::Etc::sourceparts to suppress the real one. /dev/null + # works in recent versions of apt, but not older ones (we want + # 448eaf8 in apt 0.8.0 and af13d14 in apt 0.9.3). Since this + # runs against the target chroot's apt, be conservative. + my $dummy_sources_list_d = $self->get('Dummy package path') . '/sources.list.d'; + if (!($session->test_directory($dummy_sources_list_d) || $session->mkdir($dummy_sources_list_d, { MODE => "00700"}))) { + $self->log_warning('Could not create build-depends dummy sources.list directory ' . $dummy_sources_list_d . ': ' . $!); + return 0; + } + + # Run apt-get update pointed at our dummy archive list file, and + # the empty sources.list.d directory, so that we only update + # this one source. Since apt doesn't have all the sources + # available to it in this run, any caches it generates are + # invalid, so we then need to run gencaches with all sources + # available to it. (Note that the tempting optimization to run + # apt-get update -o pkgCacheFile::Generate=0 is broken before + # 872ed75 in apt 0.9.1.) + for my $list_file ($self->get('Dummy archive list file'), + $self->get('Extra packages archive list file'), + $self->get('Extra repositories archive list file')) { + if (!$session->test_regular_file_readable($list_file)) { + next; + } + $self->run_apt_command( + { COMMAND => [$self->get_conf('APT_GET'), 'update', + '-o', 'Dir::Etc::sourcelist=' . $list_file, + '-o', 'Dir::Etc::sourceparts=' . $dummy_sources_list_d, + '--no-list-cleanup'], + ENV => {'DEBIAN_FRONTEND' => 'noninteractive'}, + USER => 'root', + DIR => '/' }); + if ($? != 0) { + return 0; + } + } + + $self->run_apt_command( + { COMMAND => [$self->get_conf('APT_CACHE'), 'gencaches'], + ENV => {'DEBIAN_FRONTEND' => 'noninteractive'}, + USER => 'root', + DIR => '/' }); + } + + if ($? != 0) { + return 0; + } + + return 1; +} + +sub upgrade { + my $self = shift; + + $self->run_apt_command( + { COMMAND => [$self->get_conf('APT_GET'), '-uy', '-o', 'Dpkg::Options::=--force-confold', 'upgrade'], + ENV => {'DEBIAN_FRONTEND' => 'noninteractive'}, + USER => 'root', + DIR => '/' }); + return $?; +} + +sub distupgrade { + my $self = shift; + + $self->run_apt_command( + { COMMAND => [$self->get_conf('APT_GET'), '-uy', '-o', 'Dpkg::Options::=--force-confold', 'dist-upgrade'], + ENV => {'DEBIAN_FRONTEND' => 'noninteractive'}, + USER => 'root', + DIR => '/' }); + return $?; +} + +sub clean { + my $self = shift; + + $self->run_apt_command( + { COMMAND => [$self->get_conf('APT_GET'), '-y', 'clean'], + ENV => {'DEBIAN_FRONTEND' => 'noninteractive'}, + USER => 'root', + DIR => '/' }); + return $?; +} + +sub autoclean { + my $self = shift; + + $self->run_apt_command( + { COMMAND => [$self->get_conf('APT_GET'), '-y', 'autoclean'], + ENV => {'DEBIAN_FRONTEND' => 'noninteractive'}, + USER => 'root', + DIR => '/' }); + return $?; +} + +sub autoremove { + my $self = shift; + + $self->run_apt_command( + { COMMAND => [$self->get_conf('APT_GET'), '-y', 'autoremove'], + ENV => {'DEBIAN_FRONTEND' => 'noninteractive'}, + USER => 'root', + DIR => '/' }); + return $?; +} + +sub add_dependencies { + my $self = shift; + my $pkg = shift; + my $build_depends = shift; + my $build_depends_arch = shift; + my $build_depends_indep = shift; + my $build_conflicts = shift; + my $build_conflicts_arch = shift; + my $build_conflicts_indep = shift; + + debug("Build-Depends: $build_depends\n") if $build_depends; + debug("Build-Depends-Arch: $build_depends_arch\n") if $build_depends_arch; + debug("Build-Depends-Indep: $build_depends_indep\n") if $build_depends_indep; + debug("Build-Conflicts: $build_conflicts\n") if $build_conflicts; + debug("Build-Conflicts-Arch: $build_conflicts_arch\n") if $build_conflicts_arch; + debug("Build-Conflicts-Indep: $build_conflicts_indep\n") if $build_conflicts_indep; + + my $deps = { + 'Build Depends' => $build_depends, + 'Build Depends Arch' => $build_depends_arch, + 'Build Depends Indep' => $build_depends_indep, + 'Build Conflicts' => $build_conflicts, + 'Build Conflicts Arch' => $build_conflicts_arch, + 'Build Conflicts Indep' => $build_conflicts_indep + }; + + $self->get('AptDependencies')->{$pkg} = $deps; +} + +sub uninstall_deps { + my $self = shift; + + my( @pkgs, @instd, @rmvd ); + + @pkgs = keys %{$self->get('Changes')->{'removed'}}; + debug("Reinstalling removed packages: @pkgs\n"); + $self->log("Failed to reinstall removed packages!\n") + if !$self->run_apt("-y", \@instd, \@rmvd, 'install', @pkgs); + debug("Installed were: @instd\n"); + debug("Removed were: @rmvd\n"); + $self->unset_removed(@instd); + $self->unset_installed(@rmvd); + + @pkgs = keys %{$self->get('Changes')->{'installed'}}; + debug("Removing installed packages: @pkgs\n"); + $self->log("Failed to remove installed packages!\n") + if !$self->run_apt("-y", \@instd, \@rmvd, 'remove', @pkgs); + $self->unset_removed(@instd); + $self->unset_installed(@rmvd); +} + +sub set_installed { + my $self = shift; + + foreach (@_) { + $self->get('Changes')->{'installed'}->{$_} = 1; + } + debug("Added to installed list: @_\n"); +} + +sub set_removed { + my $self = shift; + foreach (@_) { + $self->get('Changes')->{'removed'}->{$_} = 1; + if (exists $self->get('Changes')->{'installed'}->{$_}) { + delete $self->get('Changes')->{'installed'}->{$_}; + $self->get('Changes')->{'auto-removed'}->{$_} = 1; + debug("Note: $_ was installed\n"); + } + } + debug("Added to removed list: @_\n"); +} + +sub unset_installed { + my $self = shift; + foreach (@_) { + delete $self->get('Changes')->{'installed'}->{$_}; + } + debug("Removed from installed list: @_\n"); +} + +sub unset_removed { + my $self = shift; + foreach (@_) { + delete $self->get('Changes')->{'removed'}->{$_}; + if (exists $self->get('Changes')->{'auto-removed'}->{$_}) { + delete $self->get('Changes')->{'auto-removed'}->{$_}; + $self->get('Changes')->{'installed'}->{$_} = 1; + debug("Note: revived $_ to installed list\n"); + } + } + debug("Removed from removed list: @_\n"); +} + +sub dump_build_environment { + my $self = shift; + + my $status = $self->get_dpkg_status(); + + my $arch = $self->get('Arch'); + my ($sysname, $nodename, $release, $version, $machine) = POSIX::uname(); + $self->log_subsection("Build environment"); + $self->log("Kernel: $sysname $release $version $arch ($machine)\n"); + + $self->log("Toolchain package versions:"); + foreach my $name (sort keys %{$status}) { + foreach my $regex (@{$self->get_conf('TOOLCHAIN_REGEX')}) { + if ($name =~ m,^$regex, && defined($status->{$name}->{'Version'})) { + $self->log(' ' . $name . '_' . $status->{$name}->{'Version'}); + } + } + } + $self->log("\n"); + + $self->log("Package versions:"); + foreach my $name (sort keys %{$status}) { + if (defined($status->{$name}->{'Version'})) { + $self->log(' ' . $name . '_' . $status->{$name}->{'Version'}); + } + } + $self->log("\n"); + + return $status->{'dpkg-dev'}->{'Version'}; +} + +sub run_apt { + my $self = shift; + my $mode = shift; + my $inst_ret = shift; + my $rem_ret = shift; + my $action = shift; + my @packages = @_; + my( $msgs, $status, $pkgs, $rpkgs ); + + $msgs = ""; + # redirection of stdin from /dev/null so that conffile question + # are treated as if RETURN was pressed. + # dpkg since 1.4.1.18 issues an error on the conffile question if + # it reads EOF -- hardwire the new --force-confold option to avoid + # the questions. + my @apt_command = ($self->get_conf('APT_GET'), '--purge', + '-o', 'DPkg::Options::=--force-confold', + '-o', 'DPkg::Options::=--refuse-remove-essential', + '-o', 'APT::Install-Recommends=false', + '-o', 'Dpkg::Use-Pty=false', + '-q'); + push @apt_command, '--allow-unauthenticated' if + ($self->get_conf('APT_ALLOW_UNAUTHENTICATED')); + if ( $self->get('Host Arch') ne $self->get('Build Arch') ) { + # drop m-a:foreign and essential:yes packages that are not arch:all + # and not arch:native + push @apt_command, '--solver', 'sbuild-cross-resolver'; + } + push @apt_command, "$mode", $action, @packages; + my $pipe = + $self->pipe_apt_command( + { COMMAND => \@apt_command, + ENV => {'DEBIAN_FRONTEND' => 'noninteractive'}, + USER => 'root', + PRIORITY => 0, + DIR => '/' }); + if (!$pipe) { + $self->log("Can't open pipe to apt-get: $!\n"); + return 0; + } + + while(<$pipe>) { + $msgs .= $_; + $self->log($_) if $mode ne "-s" || debug($_); + } + close($pipe); + $status = $?; + + $pkgs = $rpkgs = ""; + if ($msgs =~ /NEW packages will be installed:\n((^[ ].*\n)*)/mi) { + ($pkgs = $1) =~ s/^[ ]*((.|\n)*)\s*$/$1/m; + $pkgs =~ s/\*//g; + } + if ($msgs =~ /packages will be REMOVED:\n((^[ ].*\n)*)/mi) { + ($rpkgs = $1) =~ s/^[ ]*((.|\n)*)\s*$/$1/m; + $rpkgs =~ s/\*//g; + } + @$inst_ret = split( /\s+/, $pkgs ); + @$rem_ret = split( /\s+/, $rpkgs ); + + $self->log("apt-get failed.\n") if $status && $mode ne "-s"; + return $mode eq "-s" || $status == 0; +} + +sub run_xapt { + my $self = shift; + my $mode = shift; + my $inst_ret = shift; + my $rem_ret = shift; + my $action = shift; + my @packages = @_; + my( $msgs, $status, $pkgs, $rpkgs ); + + $msgs = ""; + # redirection of stdin from /dev/null so that conffile question + # are treated as if RETURN was pressed. + # dpkg since 1.4.1.18 issues an error on the conffile question if + # it reads EOF -- hardwire the new --force-confold option to avoid + # the questions. + my @xapt_command = ($self->get_conf('XAPT')); + my $pipe = + $self->pipe_xapt_command( + { COMMAND => \@xapt_command, + ENV => {'DEBIAN_FRONTEND' => 'noninteractive'}, + USER => 'root', + PRIORITY => 0, + DIR => '/' }); + if (!$pipe) { + $self->log("Can't open pipe to xapt: $!\n"); + return 0; + } + + while(<$pipe>) { + $msgs .= $_; + $self->log($_) if $mode ne "-s" || debug($_); + } + close($pipe); + $status = $?; + + $pkgs = $rpkgs = ""; + if ($msgs =~ /NEW packages will be installed:\n((^[ ].*\n)*)/mi) { + ($pkgs = $1) =~ s/^[ ]*((.|\n)*)\s*$/$1/m; + $pkgs =~ s/\*//g; + } + if ($msgs =~ /packages will be REMOVED:\n((^[ ].*\n)*)/mi) { + ($rpkgs = $1) =~ s/^[ ]*((.|\n)*)\s*$/$1/m; + $rpkgs =~ s/\*//g; + } + @$inst_ret = split( /\s+/, $pkgs ); + @$rem_ret = split( /\s+/, $rpkgs ); + + $self->log("xapt failed.\n") if $status && $mode ne "-s"; + return $mode eq "-s" || $status == 0; +} + +sub format_deps { + my $self = shift; + + return join( ", ", + map { join( "|", + map { ($_->{'Neg'} ? "!" : "") . + $_->{'Package'} . + ($_->{'Rel'} ? " ($_->{'Rel'} $_->{'Version'})":"")} + scalar($_), @{$_->{'Alternatives'}}) } @_ ); +} + +sub get_dpkg_status { + my $self = shift; + my @interest = @_; + my %result; + + debug("Requesting dpkg status for packages: @interest\n"); + my $STATUS = $self->get('Session')->get_read_file_handle('/var/lib/dpkg/status'); + if (!$STATUS) { + $self->log("Can't open /var/lib/dpkg/status inside chroot: $!\n"); + return (); + } + local( $/ ) = ""; + while( <$STATUS> ) { + my( $pkg, $status, $version, $provides ); + /^Package:\s*(.*)\s*$/mi and $pkg = $1; + /^Status:\s*(.*)\s*$/mi and $status = $1; + /^Version:\s*(.*)\s*$/mi and $version = $1; + /^Provides:\s*(.*)\s*$/mi and $provides = $1; + if (!$pkg) { + $self->log_error("parse error in /var/lib/dpkg/status: no Package: field\n"); + next; + } + if (defined($version)) { + debug("$pkg ($version) status: $status\n") if $self->get_conf('DEBUG') >= 2; + } else { + debug("$pkg status: $status\n") if $self->get_conf('DEBUG') >= 2; + } + if (!$status) { + $self->log_error("parse error in /var/lib/dpkg/status: no Status: field for package $pkg\n"); + next; + } + if ($status !~ /\sinstalled$/) { + $result{$pkg}->{'Installed'} = 0 + if !(exists($result{$pkg}) && + $result{$pkg}->{'Version'} eq '~*=PROVIDED=*='); + next; + } + if (!defined $version || $version eq "") { + $self->log_error("parse error in /var/lib/dpkg/status: no Version: field for package $pkg\n"); + next; + } + $result{$pkg} = { Installed => 1, Version => $version } + if (isin( $pkg, @interest ) || !@interest); + if ($provides) { + foreach (split( /\s*,\s*/, $provides )) { + $result{$_} = { Installed => 1, Version => '~*=PROVIDED=*=' } + if isin( $_, @interest ) and (not exists($result{$_}) or + ($result{$_}->{'Installed'} == 0)); + } + } + } + close( $STATUS ); + return \%result; +} + +# Create an apt archive. Add to it if one exists. +sub setup_apt_archive { + my $self = shift; + my $dummy_pkg_name = shift; + my @pkgs = @_; + + my $session = $self->get('Session'); + + + if (!$session->chown($self->get('Dummy package path'), $self->get_conf('BUILD_USER'), 'sbuild')) { + $self->log_error("Failed to set " . $self->get_conf('BUILD_USER') . + ":sbuild ownership on dummy package dir\n"); + return 0; + } + if (!$session->chmod($self->get('Dummy package path'), '0770')) { + $self->log_error("Failed to set 0770 permissions on dummy package dir\n"); + return 0; + } + my $dummy_dir = $self->get('Dummy package path'); + my $dummy_gpghome = $dummy_dir . '/gpg'; + my $dummy_archive_dir = $dummy_dir . '/apt_archive'; + my $dummy_release_file = $dummy_archive_dir . '/Release'; + my $dummy_archive_seckey = $dummy_archive_dir . '/sbuild-key.sec'; + my $dummy_archive_pubkey = $dummy_archive_dir . '/sbuild-key.pub'; + + $self->set('Dummy archive directory', $dummy_archive_dir); + $self->set('Dummy Release file', $dummy_release_file); + my $dummy_archive_list_file = $self->get('Dummy archive list file'); + + if (!$session->test_directory($dummy_dir)) { + $self->log_warning('Could not create build-depends dummy dir ' . $dummy_dir . ': ' . $!); + return 0; + } + if (!($session->test_directory($dummy_gpghome) || $session->mkdir($dummy_gpghome, { MODE => "00700"}))) { + $self->log_warning('Could not create build-depends dummy gpg home dir ' . $dummy_gpghome . ': ' . $!); + return 0; + } + if (!$session->chown($dummy_gpghome, $self->get_conf('BUILD_USER'), 'sbuild')) { + $self->log_error('Failed to set ' . $self->get_conf('BUILD_USER') . + ':sbuild ownership on $dummy_gpghome\n'); + return 0; + } + if (!($session->test_directory($dummy_archive_dir) || $session->mkdir($dummy_archive_dir, { MODE => "00775"}))) { + $self->log_warning('Could not create build-depends dummy archive dir ' . $dummy_archive_dir . ': ' . $!); + return 0; + } + + my $dummy_pkg_dir = $dummy_dir . '/' . $dummy_pkg_name; + my $dummy_deb = $dummy_archive_dir . '/' . $dummy_pkg_name . '.deb'; + my $dummy_dsc = $dummy_archive_dir . '/' . $dummy_pkg_name . '.dsc'; + + if (!($session->mkdir("$dummy_pkg_dir", { MODE => "00775"}))) { + $self->log_warning('Could not create build-depends dummy dir ' . $dummy_pkg_dir . $!); + return 0; + } + + if (!($session->mkdir("$dummy_pkg_dir/DEBIAN", { MODE => "00775"}))) { + $self->log_warning('Could not create build-depends dummy dir ' . $dummy_pkg_dir . '/DEBIAN: ' . $!); + return 0; + } + + my $DUMMY_CONTROL = $session->get_write_file_handle("$dummy_pkg_dir/DEBIAN/control"); + if (!$DUMMY_CONTROL) { + $self->log_warning('Could not open ' . $dummy_pkg_dir . '/DEBIAN/control for writing: ' . $!); + return 0; + } + + my $arch = $self->get('Host Arch'); + print $DUMMY_CONTROL <<"EOF"; +Package: $dummy_pkg_name +Version: 0.invalid.0 +Architecture: $arch +EOF + + my @positive; + my @negative; + my @positive_arch; + my @negative_arch; + my @positive_indep; + my @negative_indep; + + for my $pkg (@pkgs) { + my $deps = $self->get('AptDependencies')->{$pkg}; + + push(@positive, $deps->{'Build Depends'}) + if (defined($deps->{'Build Depends'}) && + $deps->{'Build Depends'} ne ""); + push(@negative, $deps->{'Build Conflicts'}) + if (defined($deps->{'Build Conflicts'}) && + $deps->{'Build Conflicts'} ne ""); + if ($self->get_conf('BUILD_ARCH_ANY')) { + push(@positive_arch, $deps->{'Build Depends Arch'}) + if (defined($deps->{'Build Depends Arch'}) && + $deps->{'Build Depends Arch'} ne ""); + push(@negative_arch, $deps->{'Build Conflicts Arch'}) + if (defined($deps->{'Build Conflicts Arch'}) && + $deps->{'Build Conflicts Arch'} ne ""); + } + if ($self->get_conf('BUILD_ARCH_ALL')) { + push(@positive_indep, $deps->{'Build Depends Indep'}) + if (defined($deps->{'Build Depends Indep'}) && + $deps->{'Build Depends Indep'} ne ""); + push(@negative_indep, $deps->{'Build Conflicts Indep'}) + if (defined($deps->{'Build Conflicts Indep'}) && + $deps->{'Build Conflicts Indep'} ne ""); + } + } + + my $positive_build_deps = join(", ", @positive, + @positive_arch, @positive_indep); + my $positive = deps_parse($positive_build_deps, + reduce_arch => 1, + host_arch => $self->get('Host Arch'), + build_arch => $self->get('Build Arch'), + build_dep => 1, + reduce_profiles => 1, + build_profiles => [ split / /, $self->get('Build Profiles') ]); + if( !defined $positive ) { + my $msg = "Error! deps_parse() couldn't parse the positive Build-Depends '$positive_build_deps'"; + $self->log_error("$msg\n"); + return 0; + } + + my $negative_build_deps = join(", ", @negative, + @negative_arch, @negative_indep); + my $negative = deps_parse($negative_build_deps, + reduce_arch => 1, + host_arch => $self->get('Host Arch'), + build_arch => $self->get('Build Arch'), + build_dep => 1, + union => 1, + reduce_profiles => 1, + build_profiles => [ split / /, $self->get('Build Profiles') ]); + if( !defined $negative ) { + my $msg = "Error! deps_parse() couldn't parse the negative Build-Depends '$negative_build_deps'"; + $self->log_error("$msg\n"); + return 0; + } + + + # sbuild turns build dependencies into the dependencies of a dummy binary + # package. Since binary package dependencies do not support :native the + # architecture qualifier, these have to either be removed during native + # compilation or replaced by the build (native) architecture during cross + # building + my $handle_native_archqual = sub { + my ($dep) = @_; + if ($dep->{archqual} && $dep->{archqual} eq "native") { + if ($self->get('Host Arch') eq $self->get('Build Arch')) { + $dep->{archqual} = undef; + } else { + $dep->{archqual} = $self->get('Build Arch'); + } + } + return 1; + }; + deps_iterate($positive, $handle_native_archqual); + deps_iterate($negative, $handle_native_archqual); + + $self->log("Merged Build-Depends: $positive\n") if $positive; + $self->log("Merged Build-Conflicts: $negative\n") if $negative; + + # Filter out all but the first alternative except in special + # cases. + if (!$self->get_conf('RESOLVE_ALTERNATIVES')) { + my $positive_filtered = Dpkg::Deps::AND->new(); + foreach my $item ($positive->get_deps()) { + my $alt_filtered = Dpkg::Deps::OR->new(); + my @alternatives = $item->get_deps(); + my $first = shift @alternatives; + $alt_filtered->add($first) if defined $first; + # Allow foo (rel x) | foo (rel y) as the only acceptable + # form of alternative. i.e. where the package is the + # same, but different relations are needed, since these + # are effectively a single logical dependency. + foreach my $alt (@alternatives) { + if ($first->{'package'} eq $alt->{'package'}) { + $alt_filtered->add($alt); + } else { + last; + } + } + $positive_filtered->add($alt_filtered); + } + $positive = $positive_filtered; + } + + if ($positive ne "") { + print $DUMMY_CONTROL 'Depends: ' . $positive . "\n"; + } + if ($negative ne "") { + print $DUMMY_CONTROL 'Conflicts: ' . $negative . "\n"; + } + + $self->log("Filtered Build-Depends: $positive\n") if $positive; + $self->log("Filtered Build-Conflicts: $negative\n") if $negative; + + print $DUMMY_CONTROL <<"EOF"; +Maintainer: Debian buildd-tools Developers <buildd-tools-devel\@lists.alioth.debian.org> +Description: Dummy package to satisfy dependencies with apt - created by sbuild + This package was created automatically by sbuild and should never appear on + a real system. You can safely remove it. +EOF + close ($DUMMY_CONTROL); + + foreach my $path ($dummy_pkg_dir . '/DEBIAN/control', + $dummy_pkg_dir . '/DEBIAN', + $dummy_pkg_dir, + $dummy_archive_dir) { + if (!$session->chown($path, $self->get_conf('BUILD_USER'), 'sbuild')) { + $self->log_error("Failed to set " . $self->get_conf('BUILD_USER') + . ":sbuild ownership on $path\n"); + return 0; + } + } + + # Now build the package: + # NO_PKG_MANGLE=1 disables https://launchpad.net/pkgbinarymangler (only used on Ubuntu) + $session->run_command( + { COMMAND => ['env', 'NO_PKG_MANGLE=1', 'dpkg-deb', '--build', $dummy_pkg_dir, $dummy_deb], + USER => $self->get_conf('BUILD_USER'), + PRIORITY => 0}); + if ($?) { + $self->log("Dummy package creation failed\n"); + return 0; + } + + # Write the dummy dsc file. + my $dummy_dsc_fh = $session->get_write_file_handle($dummy_dsc); + if (!$dummy_dsc_fh) { + $self->log_warning('Could not open ' . $dummy_dsc . ' for writing: ' . $!); + return 0; + } + + print $dummy_dsc_fh <<"EOF"; +Format: 1.0 +Source: $dummy_pkg_name +Binary: $dummy_pkg_name +Architecture: any +Version: 0.invalid.0 +Maintainer: Debian buildd-tools Developers <buildd-tools-devel\@lists.alioth.debian.org> +EOF + if (scalar(@positive)) { + print $dummy_dsc_fh 'Build-Depends: ' . join(", ", @positive) . "\n"; + } + if (scalar(@negative)) { + print $dummy_dsc_fh 'Build-Conflicts: ' . join(", ", @negative) . "\n"; + } + if (scalar(@positive_arch)) { + print $dummy_dsc_fh 'Build-Depends-Arch: ' . join(", ", @positive_arch) . "\n"; + } + if (scalar(@negative_arch)) { + print $dummy_dsc_fh 'Build-Conflicts-Arch: ' . join(", ", @negative_arch) . "\n"; + } + if (scalar(@positive_indep)) { + print $dummy_dsc_fh 'Build-Depends-Indep: ' . join(", ", @positive_indep) . "\n"; + } + if (scalar(@negative_indep)) { + print $dummy_dsc_fh 'Build-Conflicts-Indep: ' . join(", ", @negative_indep) . "\n"; + } + print $dummy_dsc_fh "\n"; + close $dummy_dsc_fh; + + # Do code to run apt-ftparchive + if (!$self->run_apt_ftparchive($self->get('Dummy archive directory'))) { + $self->log("Failed to run apt-ftparchive.\n"); + return 0; + } + + # Write a list file for the dummy archive if one not create yet. + if (!$session->test_regular_file($dummy_archive_list_file)) { + my $tmpfilename = $session->mktemp(); + + if (!$tmpfilename) { + $self->log_error("Can't create tempfile\n"); + return 0; + } + + my $tmpfh = $session->get_write_file_handle($tmpfilename); + if (!$tmpfh) { + $self->log_error("Cannot open pipe: $!\n"); + return 0; + } + + # We always trust the dummy apt repositories by setting trusted=yes. + # + # We use copy:// instead of file:// as URI because the latter will make + # apt use symlinks in /var/lib/apt/lists. These symlinks will become + # broken after the dummy archive is removed. This in turn confuses + # launchpad-buildd which directly tries to access + # /var/lib/apt/lists/*_Packages and cannot use `apt-get indextargets` as + # that apt feature is too new for it. + print $tmpfh 'deb [trusted=yes] copy://' . $dummy_archive_dir . " ./\n"; + print $tmpfh 'deb-src [trusted=yes] copy://' . $dummy_archive_dir . " ./\n"; + + close($tmpfh); + # List file needs to be moved with root. + if (!$session->chmod($tmpfilename, '0644')) { + $self->log("Failed to create apt list file for dummy archive.\n"); + $session->unlink($tmpfilename); + return 0; + } + if (!$session->rename($tmpfilename, $dummy_archive_list_file)) { + $self->log("Failed to create apt list file for dummy archive.\n"); + $session->unlink($tmpfilename); + return 0; + } + } + + return 1; +} + +# Remove the apt archive. +sub cleanup_apt_archive { + my $self = shift; + + my $session = $self->get('Session'); + + if (defined $self->get('Dummy package path')) { + $session->unlink($self->get('Dummy package path'), { RECURSIVE => 1, FORCE => 1 }); + } + + if (defined $self->get('Extra packages path')) { + $session->unlink($self->get('Extra packages path'), { RECURSIVE => 1, FORCE => 1 }); + } + + $session->unlink($self->get('Dummy archive list file'), { FORCE => 1 }); + + $session->unlink($self->get('Extra repositories archive list file'), { FORCE => 1 }); + + $session->unlink($self->get('Extra packages archive list file'), { FORCE => 1 }); + + $self->set('Extra packages path', undef); + $self->set('Extra packages archive directory', undef); + $self->set('Extra packages release file', undef); + $self->set('Dummy archive directory', undef); + $self->set('Dummy Release file', undef); +} + +# Function that runs apt-ftparchive +sub run_apt_ftparchive { + my $self = shift; + my $dummy_archive_dir = shift; + + my $session = $self->get('Session'); + + # We create the Packages, Sources and Release file inside the chroot. + # We cannot use Digest::MD5, or Digest::SHA because + # they are not available inside a chroot with only Essential:yes and apt + # installed. + # We cannot use apt-ftparchive as this is not available inside the chroot. + # Apt-ftparchive outside the chroot might not have access to the files + # inside the chroot (for example when using qemu or ssh backends). + # The only alternative would've been to set up the archive outside the + # chroot using apt-ftparchive and to then copy Packages, Sources and + # Release into the chroot. + # We do not do this to avoid copying files from and to the chroot. + # At the same time doing it like this has the advantage to have less + # dependencies of sbuild itself (no apt-ftparchive needed). + # The disadvantage of doing it this way is that we now have to maintain + # our own code creating the Release file which might break in the future. + my $packagessourcescmd = <<'SCRIPTEND'; +use strict; +use warnings; + +use POSIX qw(strftime); +use POSIX qw(locale_h); + +# Execute a command without /bin/sh but plain execvp while redirecting its +# standard output to a file given as the first argument. +# Using "print $fh `my_command`" has the disadvantage that "my_command" might +# be executed through /bin/sh (depending on the characters used) or that the +# output of "my_command" is very long. + +sub hash_file($$) +{ + my ($filename, $util) = @_; + my $output = `$util $filename`; + my ($hash, undef) = split /\s+/, $output; + return $hash; +} + +{ + opendir(my $dh, '.') or die "Can't opendir('.'): $!"; + open my $out, '>', 'Packages'; + while (my $entry = readdir $dh) { + next if $entry !~ /\.deb$/; + open my $in, '-|', 'dpkg-deb', '-I', $entry, 'control' or die "cannot fork dpkg-deb"; + while (my $line = <$in>) { + print $out $line; + } + close $in; + my $size = -s $entry; + my $md5 = hash_file($entry, 'md5sum'); + my $sha1 = hash_file($entry, 'sha1sum'); + my $sha256 = hash_file($entry, 'sha256sum'); + print $out "Size: $size\n"; + print $out "MD5sum: $md5\n"; + print $out "SHA1: $sha1\n"; + print $out "SHA256: $sha256\n"; + print $out "Filename: ./$entry\n"; + print $out "\n"; + } + close $out; + closedir($dh); +} +{ + opendir(my $dh, '.') or die "Can't opendir('.'): $!"; + open my $out, '>', 'Sources'; + while (my $entry = readdir $dh) { + next if $entry !~ /\.dsc$/; + my $size = -s $entry; + my $md5 = hash_file($entry, 'md5sum'); + my $sha1 = hash_file($entry, 'sha1sum'); + my $sha256 = hash_file($entry, 'sha256sum'); + my ($sha1_printed, $sha256_printed, $files_printed) = (0, 0, 0); + open my $in, '<', $entry or die "cannot open $entry"; + while (my $line = <$in>) { + next if $line eq "\n"; + $line =~ s/^Source:/Package:/; + print $out $line; + if ($line eq "Checksums-Sha1:\n") { + print $out " $sha1 $size $entry\n"; + $sha1_printed = 1; + } elsif ($line eq "Checksums-Sha256:\n") { + print $out " $sha256 $size $entry\n"; + $sha256_printed = 1; + } elsif ($line eq "Files:\n") { + print $out " $md5 $size $entry\n"; + $files_printed = 1; + } + } + close $in; + if ($sha1_printed == 0) { + print $out "Checksums-Sha1:\n"; + print $out " $sha1 $size $entry\n"; + } + if ($sha256_printed == 0) { + print $out "Checksums-Sha256:\n"; + print $out " $sha256 $size $entry\n"; + } + if ($files_printed == 0) { + print $out "Files:\n"; + print $out " $md5 $size $entry\n"; + } + print $out "Directory: .\n"; + print $out "\n"; + } + close $out; + closedir($dh); +} + +my $packages_md5 = hash_file('Packages', 'md5sum'); +my $sources_md5 = hash_file('Sources', 'md5sum'); + +my $packages_sha1 = hash_file('Packages', 'sha1sum'); +my $sources_sha1 = hash_file('Sources', 'sha1sum'); + +my $packages_sha256 = hash_file('Packages', 'sha256sum'); +my $sources_sha256 = hash_file('Sources', 'sha256sum'); + +my $packages_size = -s 'Packages'; +my $sources_size = -s 'Sources'; + +# The timestamp format of release files is documented here: +# https://wiki.debian.org/RepositoryFormat#Date.2CValid-Until +# It is specified to be the same format as described in Debian Policy §4.4 +# https://www.debian.org/doc/debian-policy/ch-source.html#s-dpkgchangelog +# or the same as in debian/changelog or the Date field in .changes files. +# or the same format as `date -R` +# To adhere to the specified format, the C or C.UTF-8 locale must be used. +my $old_locale = setlocale(LC_TIME); +setlocale(LC_TIME, "C.UTF-8"); +my $datestring = strftime "%a, %d %b %Y %H:%M:%S +0000", gmtime(); +setlocale(LC_TIME, $old_locale); + +open(my $releasefh, '>', 'Release') or die "cannot open Release for writing: $!"; + +print $releasefh <<"END"; +Codename: invalid-sbuild-codename +Date: $datestring +Description: Sbuild Build Dependency Temporary Archive +Label: sbuild-build-depends-archive +Origin: sbuild-build-depends-archive +Suite: invalid-sbuild-suite +MD5Sum: + $packages_md5 $packages_size Packages + $sources_md5 $sources_size Sources +SHA1: + $packages_sha1 $packages_size Packages + $sources_sha1 $sources_size Sources +SHA256: + $packages_sha256 $packages_size Packages + $sources_sha256 $sources_size Sources +END + +close $releasefh; + +SCRIPTEND + + # Instead of using $(perl -e) and passing $packagessourcescmd as a command + # line argument, feed perl from standard input because otherwise the + # command line will be too long for certain backends (like the autopkgtest + # qemu backend). + my $pipe = $session->pipe_command( + { COMMAND => ['perl'], + USER => "root", + DIR => $dummy_archive_dir, + PIPE => 'out', + }); + if (!$pipe) { + $self->log_error("cannot open pipe\n"); + return 0; + } + print $pipe $packagessourcescmd; + close $pipe; + if ($? ne 0) { + $self->log_error("cannot create dummy archive\n"); + return 0; + } + + return 1; +} + +sub get_apt_command_internal { + my $self = shift; + my $options = shift; + + my $command = $options->{'COMMAND'}; + my $apt_options = $self->get('APT Options'); + + debug2("APT Options: ", join(" ", @$apt_options), "\n") + if defined($apt_options); + + my @aptcommand = (); + if (defined($apt_options)) { + push(@aptcommand, @{$command}[0]); + push(@aptcommand, @$apt_options); + if ($#$command > 0) { + push(@aptcommand, @{$command}[1 .. $#$command]); + } + } else { + @aptcommand = @$command; + } + + debug2("APT Command: ", join(" ", @aptcommand), "\n"); + + $options->{'INTCOMMAND'} = \@aptcommand; +} + +sub run_apt_command { + my $self = shift; + my $options = shift; + + my $session = $self->get('Session'); + my $host = $self->get('Host'); + + # Set modfied command + $self->get_apt_command_internal($options); + + if ($self->get('Split')) { + return $host->run_command_internal($options); + } else { + return $session->run_command_internal($options); + } +} + +sub pipe_apt_command { + my $self = shift; + my $options = shift; + + my $session = $self->get('Session'); + my $host = $self->get('Host'); + + # Set modfied command + $self->get_apt_command_internal($options); + + if ($self->get('Split')) { + return $host->pipe_command_internal($options); + } else { + return $session->pipe_command_internal($options); + } +} + +sub pipe_xapt_command { + my $self = shift; + my $options = shift; + + my $session = $self->get('Session'); + my $host = $self->get('Host'); + + # Set modfied command + $self->get_apt_command_internal($options); + + if ($self->get('Split')) { + return $host->pipe_command_internal($options); + } else { + return $session->pipe_command_internal($options); + } +} + +sub get_aptitude_command_internal { + my $self = shift; + my $options = shift; + + my $command = $options->{'COMMAND'}; + my $apt_options = $self->get('Aptitude Options'); + + debug2("Aptitude Options: ", join(" ", @$apt_options), "\n") + if defined($apt_options); + + my @aptcommand = (); + if (defined($apt_options)) { + push(@aptcommand, @{$command}[0]); + push(@aptcommand, @$apt_options); + if ($#$command > 0) { + push(@aptcommand, @{$command}[1 .. $#$command]); + } + } else { + @aptcommand = @$command; + } + + debug2("APT Command: ", join(" ", @aptcommand), "\n"); + + $options->{'INTCOMMAND'} = \@aptcommand; +} + +sub run_aptitude_command { + my $self = shift; + my $options = shift; + + my $session = $self->get('Session'); + my $host = $self->get('Host'); + + # Set modfied command + $self->get_aptitude_command_internal($options); + + if ($self->get('Split')) { + return $host->run_command_internal($options); + } else { + return $session->run_command_internal($options); + } +} + +sub pipe_aptitude_command { + my $self = shift; + my $options = shift; + + my $session = $self->get('Session'); + my $host = $self->get('Host'); + + # Set modfied command + $self->get_aptitude_command_internal($options); + + if ($self->get('Split')) { + return $host->pipe_command_internal($options); + } else { + return $session->pipe_command_internal($options); + } +} + +sub get_sbuild_dummy_pkg_name { + my $self = shift; + my $name = shift; + + return 'sbuild-build-depends-' . $name. '-dummy'; +} + +1; diff --git a/lib/Sbuild/Sysconfig.pm.in b/lib/Sbuild/Sysconfig.pm.in new file mode 100644 index 0000000..8f5cbb5 --- /dev/null +++ b/lib/Sbuild/Sysconfig.pm.in @@ -0,0 +1,84 @@ +# +# Sysconfig.pm: system configuration for sbuild +# Copyright © 2007-2008 Roger Leigh <rleigh@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::Sysconfig; + +use strict; +use warnings; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT_OK); + + @ISA = qw(Exporter); + + @EXPORT_OK = qw($version $release_date $compat_mode %paths %programs); +} + +our $version = "@PACKAGE_VERSION@"; +our $release_date = "@RELEASE_DATE@"; +our $compat_mode = @SBUILD_COMPAT@; + +# Paths +my $prefix = "@prefix@"; +my $exec_prefix = "@exec_prefix@"; +# Depend on prefix +my $includedir = "@includedir@"; +my $localstatedir = "@localstatedir@"; +my $sharedstatedir = "@sharedstatedir@"; +my $sysconfdir = "@sysconfdir@"; +# Depend on exec_prefix +my $bindir = "@bindir@"; +my $libdir = "@libdir@"; +my $libexecdir = "@libexecdir@"; +my $sbindir = "@sbindir@"; +# Data directories +my $datarootdir = "@datarootdir@"; +my $datadir = "@datadir@"; +my $localedir = "@localedir@"; +my $mandir = "@mandir@"; + +our %paths = ( + 'PREFIX' => $prefix, + 'EXEC_PREFIX' => $exec_prefix, + 'INCLUDEDIR' => $includedir, + 'LOCALSTATEDIR' => $localstatedir, + 'SHAREDSTATEDIR' => $sharedstatedir, + 'SYSCONFDIR' => $sysconfdir, + 'BINDIR' => $bindir, + 'LIBDIR' => $libdir, + 'LIBEXECDIR' => $libexecdir, + 'SBINDIR' => $sbindir, + 'DATAROOTDIR' => $datarootdir, + 'DATADIR' => $datadir, + 'LOCALEDIR' => $localedir, + 'MANDIR' => $mandir, + 'BUILDD_CONF' => "@BUILDD_CONF@", + 'BUILDD_SYSCONF_DIR' => "@BUILDD_SYSCONF_DIR@", + 'SBUILD_CONF' => "@SBUILD_CONF@", + 'SBUILD_DATA_DIR' => "@SBUILD_DATA_DIR@", + 'SBUILD_LIBEXEC_DIR' => "@SBUILD_LIBEXEC_DIR@", + 'SBUILD_LOCALSTATE_DIR' => "$localstatedir/lib/sbuild", + 'SBUILD_SYSCONF_DIR' => "@SBUILD_SYSCONF_DIR@", + 'SCHROOT_CONF' => "@SCHROOT_CONF@", + 'SCHROOT_SYSCONF_DIR' => "@SCHROOT_SYSCONF_DIR@" +); + +1; diff --git a/lib/Sbuild/Utility.pm b/lib/Sbuild/Utility.pm new file mode 100644 index 0000000..5a59b28 --- /dev/null +++ b/lib/Sbuild/Utility.pm @@ -0,0 +1,631 @@ +# +# Utility.pm: library for sbuild utility programs +# Copyright © 2006 Roger Leigh <rleigh@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, write to the Free Software +# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA +# +############################################################################ + +# Import default modules into main +package main; +use Sbuild qw($devnull); +use Sbuild::Sysconfig; + +$ENV{'LC_ALL'} = "C.UTF-8"; +$ENV{'SHELL'} = '/bin/sh'; + +# avoid intermixing of stdout and stderr +$| = 1; + +package Sbuild::Utility; + +use strict; +use warnings; + +use Sbuild::Chroot; +use File::Temp qw(tempfile); +use Module::Load::Conditional qw(can_load); # Used to check for LWP::UserAgent +use Time::HiRes qw ( time ); # Needed for high resolution timers + +sub get_dist ($); +sub setup ($$$); +sub cleanup ($); +sub shutdown ($); +sub get_unshare_cmd($); +sub get_tar_compress_option($); + +my $current_session; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter); + + @EXPORT = qw(setup cleanup shutdown check_url download get_unshare_cmd + read_subuid_subgid CLONE_NEWNS CLONE_NEWUTS CLONE_NEWIPC CLONE_NEWUSER + CLONE_NEWPID CLONE_NEWNET test_unshare get_tar_compress_options); + + $SIG{'INT'} = \&shutdown; + $SIG{'TERM'} = \&shutdown; + $SIG{'ALRM'} = \&shutdown; + $SIG{'PIPE'} = \&shutdown; +} + +sub get_dist ($) { + my $dist = shift; + + $dist = "unstable" if ($dist eq "-u" || $dist eq "u"); + $dist = "testing" if ($dist eq "-t" || $dist eq "t"); + $dist = "stable" if ($dist eq "-s" || $dist eq "s"); + $dist = "oldstable" if ($dist eq "-o" || $dist eq "o"); + $dist = "experimental" if ($dist eq "-e" || $dist eq "e"); + + return $dist; +} + +sub setup ($$$) { + my $namespace = shift; + my $distribution = shift; + my $conf = shift; + + $conf->set('VERBOSE', 1); + $conf->set('NOLOG', 1); + + $distribution = get_dist($distribution); + + # TODO: Allow user to specify arch. + # Use require instead of 'use' to avoid circular dependencies when + # ChrootInfo modules happen to make use of this module + my $chroot_info; + if ($conf->get('CHROOT_MODE') eq 'schroot') { + require Sbuild::ChrootInfoSchroot; + $chroot_info = Sbuild::ChrootInfoSchroot->new($conf); + } elsif ($conf->get('CHROOT_MODE') eq 'autopkgtest') { + require Sbuild::ChrootInfoAutopkgtest; + $chroot_info = Sbuild::ChrootInfoAutopkgtest->new($conf); + } elsif ($conf->get('CHROOT_MODE') eq 'unshare') { + require Sbuild::ChrootInfoUnshare; + $chroot_info = Sbuild::ChrootInfoUnshare->new($conf); + } else { + require Sbuild::ChrootInfoSudo; + $chroot_info = Sbuild::ChrootInfoSudo->new($conf); + } + + my $session; + + $session = $chroot_info->create($namespace, + $distribution, + undef, # TODO: Add --chroot option + $conf->get('BUILD_ARCH')); + + if (!defined $session) { + print STDERR "Error creating chroot info\n"; + return undef; + } + + $session->set('Log Stream', \*STDOUT); + + my $chroot_defaults = $session->get('Defaults'); + $chroot_defaults->{'DIR'} = '/'; + $chroot_defaults->{'STREAMIN'} = $Sbuild::devnull; + $chroot_defaults->{'STREAMOUT'} = \*STDOUT; + $chroot_defaults->{'STREAMERR'} =\*STDOUT; + + $Sbuild::Utility::current_session = $session; + + if (!$session->begin_session()) { + print STDERR "Error setting up $distribution chroot\n"; + return undef; + } + + if (defined(&main::local_setup)) { + return main::local_setup($session); + } + return $session; +} + +sub cleanup ($) { + my $conf = shift; + + if (defined(&main::local_cleanup)) { + main::local_cleanup($Sbuild::Utility::current_session); + } + if (defined $Sbuild::Utility::current_session) { + $Sbuild::Utility::current_session->end_session(); + } +} + +sub shutdown ($) { + cleanup($main::conf); # FIXME: don't use global + exit 1; +} + +# This method simply checks if a URL is valid. +sub check_url { + my ($url) = @_; + + # If $url is a readable plain file on the local system, just return true. + return 1 if (-f $url && -r $url); + + # Load LWP::UserAgent if possible, else return 0. + if (! can_load( modules => { 'LWP::UserAgent' => undef, } )) { + warn "install the libwww-perl package to support downloading dsc files"; + return 0; + } + + # Setup the user agent. + my $ua = LWP::UserAgent->new; + + # Determine if we need to specify any proxy settings. + $ua->env_proxy; + my $proxy = _get_proxy(); + if ($proxy) { + $ua->proxy(['http', 'ftp'], $proxy); + } + + # Dispatch a HEAD request, grab the response, and check the response for + # success. + my $res = $ua->head($url); + return 1 if ($res->is_success); + + # URL wasn't valid. + return 0; +} + +# This method is used to retrieve a file, usually from a location on the +# Internet, but it can also be used for files in the local system. +# $url is location of file, $file is path to write $url into. +sub download { + # The parameters will be any URL and a location to save the file to. + my($url, $file) = @_; + + # If $url is a readable plain file on the local system, just return the + # $url. + return $url if (-f $url && -r $url); + + # Load LWP::UserAgent if possible, else return 0. + if (! can_load( modules => { 'LWP::UserAgent' => undef, } )) { + return 0; + } + + # Filehandle we'll be writing to. + my $fh; + + # If $file isn't defined, a temporary file will be used instead. + ($fh, $file) = tempfile( UNLINK => 0 ) if (! $file); + + # Setup the user agent. + my $ua = LWP::UserAgent->new; + + # Determine if we need to specify any proxy settings. + $ua->env_proxy; + my $proxy = _get_proxy(); + if ($proxy) { + $ua->proxy(['http', 'ftp'], $proxy); + } + + # Download the file. + print "Downloading $url to $file.\n"; + my $expected_length; # Total size we expect of content + my $bytes_received = 0; # Size of content as it is received + my $percent; # The percentage downloaded + my $tick; # Used for counting. + my $start_time = time; # Record of the start time + open($fh, '>', $file); # Destination file to download content to + my $request = HTTP::Request->new(GET => $url); + my $response = $ua->request($request, + sub { + # Our own content callback subroutine + my ($chunk, $response) = @_; + + $bytes_received += length($chunk); + unless (defined $expected_length) { + $expected_length = $response->content_length or undef; + } + if ($expected_length) { + # Here we calculate the speed of the download to print out later + my $speed; + my $duration = time - $start_time; + if ($bytes_received/$duration >= 1024 * 1024) { + $speed = sprintf("%.4g MB", + ($bytes_received/$duration) / (1024.0 * 1024)) . "/s"; + } elsif ($bytes_received/$duration >= 1024) { + $speed = sprintf("%.4g KB", + ($bytes_received/$duration) / 1024.0) . "/s"; + } else { + $speed = sprintf("%.4g B", + ($bytes_received/$duration)) . "/s"; + } + # Calculate the percentage downloaded + $percent = sprintf("%d", + 100 * $bytes_received / $expected_length); + $tick++; # Keep count + # Here we print out a progress of the download. We start by + # printing out the amount of data retrieved so far, and then + # show a progress bar. After 50 ticks, the percentage is printed + # and the speed of the download is printed. A new line is + # started and the process repeats until the download is + # complete. + if (($tick == 250) or ($percent == 100)) { + if ($tick == 1) { + # In case we reach 100% from tick 1. + printf "%8s", sprintf("%d", + $bytes_received / 1024) . "KB"; + print " [."; + } + while ($tick != 250) { + # In case we reach 100% before reaching 250 ticks + print "." if ($tick % 5 == 0); + $tick++; + } + print ".]"; + printf "%5s", "$percent%"; + printf "%12s", "$speed\n"; + $tick = 0; + } elsif ($tick == 1) { + printf "%8s", sprintf("%d", + $bytes_received / 1024) . "KB"; + print " [."; + } elsif ($tick % 5 == 0) { + print "."; + } + } + # Write the contents of the download to our specified file + if ($response->is_success) { + print $fh $chunk; # Print content to file + } else { + # Print message upon failure during download + print "\n" . $response->status_line . "\n"; + return 0; + } + } + ); # End of our content callback subroutine + close $fh; # Close the destination file + + # Print error message in case we couldn't get a response at all. + if (!$response->is_success) { + print $response->status_line . "\n"; + return 0; + } + + # Print out amount of content received before returning the path of the + # file. + print "Download of $url successful.\n"; + print "Size of content downloaded: "; + if ($bytes_received >= 1024 * 1024) { + print sprintf("%.4g MB", + $bytes_received / (1024.0 * 1024)) . "\n"; + } elsif ($bytes_received >= 1024) { + print sprintf("%.4g KB", $bytes_received / 1024.0) . "\n"; + } else { + print sprintf("%.4g B", $bytes_received) . "\n"; + } + + return $file; +} + +# This method is used to determine the proxy settings used on the local system. +# It will return the proxy URL if a proxy setting is found. +sub _get_proxy { + my $proxy; + + # Attempt to acquire a proxy URL from apt-config. + if (open(my $apt_config_output, '-|', '/usr/bin/apt-config dump')) { + foreach my $tmp (<$apt_config_output>) { + if ($tmp =~ m/^.*Acquire::http::Proxy\s+/) { + $proxy = $tmp; + chomp($proxy); + # Trim the line to only the proxy URL + $proxy =~ s/^.*Acquire::http::Proxy\s+"|";$//g; + return $proxy; + } + } + close $apt_config_output; + } + + # Attempt to acquire a proxy URL from the user's or system's wgetrc + # configuration. + # First try the user's wgetrc + if (open(my $wgetrc, '<', "$ENV{'HOME'}/.wgetrc")) { + foreach my $tmp (<$wgetrc>) { + if ($tmp =~ m/^[^#]*http_proxy/) { + $proxy = $tmp; + chomp($proxy); + # Trim the line to only the proxy URL + $proxy =~ s/^.*http_proxy\s*=\s*|\s+$//g; + return $proxy; + } + } + close($wgetrc); + } + # Now try the system's wgetrc + if (open(my $wgetrc, '<', '/etc/wgetrc')) { + foreach my $tmp (<$wgetrc>) { + if ($tmp =~ m/^[^#]*http_proxy/) { + $proxy = $tmp; + chomp($proxy); + # Trim the line to only the proxy URL + $proxy =~ s/^.*http_proxy\s*=\s*|\s+$//g; + return $proxy; + } + } + close($wgetrc); + } + + # At this point there should be no proxy settings. Return undefined. + return 0; +} + +# from sched.h +use constant { + CLONE_NEWNS => 0x20000, + CLONE_NEWUTS => 0x4000000, + CLONE_NEWIPC => 0x8000000, + CLONE_NEWUSER => 0x10000000, + CLONE_NEWPID => 0x20000000, + CLONE_NEWNET => 0x40000000, +}; + +sub get_unshare_cmd($) { + my $options = shift; + + my @idmap = @{$options->{'IDMAP'}}; + + my $unshare_flags = CLONE_NEWUSER; + + if (defined($options->{'UNSHARE_FLAGS'})) { + $unshare_flags |= $options->{'UNSHARE_FLAGS'}; + } + + my $uidmapcmd = ""; + my $gidmapcmd = ""; + foreach (@idmap) { + my ($t, $hostid, $nsid, $range) = @{$_}; + if ($t ne "u" and $t ne "g" and $t ne "b") { + die "invalid idmap type: $t"; + } + if ($t eq "u" or $t eq "b") { + $uidmapcmd .= " $hostid $nsid $range"; + } + if ($t eq "g" or $t eq "b") { + $gidmapcmd .= " $hostid $nsid $range"; + } + } + my $idmapcmd = ''; + if ($uidmapcmd ne "") { + $idmapcmd .= "0 == system \"newuidmap \$ppid $uidmapcmd\" or die \"newuidmap failed: \$!\";"; + } + if ($gidmapcmd ne "") { + $idmapcmd .= "0 == system \"newgidmap \$ppid $gidmapcmd\" or die \"newgidmap failed: \$!\";"; + } + + my $command = <<"EOF"; +require 'syscall.ph'; + +# Create a pipe for the parent process to signal the child process that it is +# done with calling unshare() so that the child can go ahead setting up +# uid_map and gid_map. +pipe my \$rfh, my \$wfh; + +# We have to do this dance with forking a process and then modifying the +# parent from the child because: +# - new[ug]idmap can only be called on a process id after that process has +# unshared the user namespace +# - a process looses its capabilities if it performs an execve() with nonzero +# user ids see the capabilities(7) man page for details. +# - a process that unshared the user namespace by default does not have the +# privileges to call new[ug]idmap on itself +# +# this also works the other way around (the child setting up a user namespace +# and being modified from the parent) but that way, the parent would have to +# stay around until the child exited (so a pid would be wasted). Additionally, +# that variant would require an additional pipe to let the parent signal the +# child that it is done with calling new[ug]idmap. The way it is done here, +# this signaling can instead be done by wait()-ing for the exit of the child. +my \$ppid = \$\$; +my \$cpid = fork() // die "fork() failed: \$!"; +if (\$cpid == 0) { + # child + + # Close the writing descriptor at our end of the pipe so that we see EOF + # when parent closes its descriptor. + close \$wfh; + + # Wait for the parent process to finish its unshare() call by waiting for + # an EOF. + 0 == sysread \$rfh, my \$c, 1 or die "read() did not receive EOF"; + + # The program's new[ug]idmap have to be used because they are setuid root. + # These privileges are needed to map the ids from /etc/sub[ug]id to the + # user namespace set up by the parent. Without these privileges, only the + # id of the user itself can be mapped into the new namespace. + # + # Since new[ug]idmap is setuid root we also don't need to write "deny" to + # /proc/\$\$/setgroups beforehand (this is otherwise required for + # unprivileged processes trying to write to /proc/\$\$/gid_map since kernel + # version 3.19 for security reasons) and therefore the parent process + # keeps its ability to change its own group here. + # + # Since /proc/\$ppid/[ug]id_map can only be written to once, respectively, + # instead of making multiple calls to new[ug]idmap, we assemble a command + # line that makes one call each. + $idmapcmd + exit 0; +} + +# parent + +# After fork()-ing, the parent immediately calls unshare... +0 == syscall &SYS_unshare, $unshare_flags or die "unshare() failed: \$!"; + +# .. and then signals the child process that we are done with the unshare() +# call by sending an EOF. +close \$wfh; + +# Wait for the child process to finish its setup by waiting for its exit. +\$cpid == waitpid \$cpid, 0 or die "waitpid() failed: \$!"; +if (\$? != 0) { + die "child had a non-zero exit status: \$?"; +} + +# Currently we are nobody (uid and gid are 65534). So we become root user and +# group instead. +# +# We are using direct syscalls instead of setting \$(, \$), \$< and \$> because +# then perl would do additional stuff which we don't need or want here, like +# checking /proc/sys/kernel/ngroups_max (which might not exist). It would also +# also call setgroups() in a way that makes the root user be part of the +# group unknown. +0 == syscall &SYS_setgid, 0 or die "setgid failed: \$!"; +0 == syscall &SYS_setuid, 0 or die "setuid failed: \$!"; +0 == syscall &SYS_setgroups, 0, 0 or die "setgroups failed: \$!"; +EOF + + if ($options->{'FORK'}) { + $command .= <<"EOF"; +# When the pid namespace is also unshared, then processes expect a master pid +# to always be alive within the namespace. To achieve this, we fork() here +# instead of exec() to always have one dummy process running as pid 1 inside +# the namespace. This is also what the unshare tool does when used with the +# --fork option. +# +# Otherwise, without a pid 1, new processes cannot be forked anymore after pid +# 1 finished. +my \$cpid = fork() // die "fork() failed: \$!"; +if (\$cpid != 0) { + # The parent process will stay alive as pid 1 in this namespace until + # the child finishes executing. This is important because pid 1 must + # never die or otherwise nothing new can be forked. + \$cpid == waitpid \$cpid, 0 or die "waitpid() failed: \$!"; + exit (\$? >> 8); +} +EOF + } + + $command .= 'exec { $ARGV[0] } @ARGV or die "exec() failed: $!";'; + # remove code comments + $command =~ s/^\s*#.*$//gm; + # remove whitespace at beginning and end + $command =~ s/^\s+//gm; + $command =~ s/\s+$//gm; + # remove linebreaks + $command =~ s/\n//gm; + return ('perl', '-e', $command); +} + +sub read_subuid_subgid() { + my $username = getpwuid $<; + my ($subid, $num_subid, $fh, $n); + my @result = (); + + if (! -e "/etc/subuid") { + printf STDERR "/etc/subuid doesn't exist\n"; + return; + } + if (! -r "/etc/subuid") { + printf STDERR "/etc/subuid is not readable\n"; + return; + } + + open $fh, "<", "/etc/subuid" or die "cannot open /etc/subuid for reading: $!"; + while (my $line = <$fh>) { + ($n, $subid, $num_subid) = split(/:/, $line, 3); + last if ($n eq $username); + } + close $fh; + + if ($n ne $username) { + printf STDERR "No entry for $username in /etc/subuid"; + return; + } + + push @result, ["u", 0, $subid, $num_subid]; + + open $fh, "<", "/etc/subgid" or die "cannot open /etc/subgid for reading: $!"; + while (my $line = <$fh>) { + ($n, $subid, $num_subid) = split(/:/, $line, 3); + last if ($n eq $username); + } + close $fh; + + if ($n ne $username) { + printf STDERR "No entry for $username in /etc/subgid"; + return; + } + + push @result, ["g", 0, $subid, $num_subid]; + + return @result; +} + +sub test_unshare() { + # we spawn a new per process because if unshare succeeds, we would + # otherwise have unshared the sbuild process itself which we don't want + my $pid = fork(); + if ($pid == 0) { + require "syscall.ph"; + my $ret = syscall &SYS_unshare, CLONE_NEWUSER; + if (($ret >> 8) == 0) { + exit 0; + } else { + exit 1; + } + } + waitpid($pid, 0); + if (($? >> 8) != 0) { + printf STDERR "E: unshare failed: $!\n"; + my $procfile = '/proc/sys/kernel/unprivileged_userns_clone'; + open(my $fh, '<', $procfile) or die "failed to open $procfile"; + chomp(my $content = do { local $/; <$fh> }); + close($fh); + if ($content ne "1") { + print STDERR "I: /proc/sys/kernel/unprivileged_userns_clone is set to $content\n"; + print STDERR "I: try running: sudo sysctl -w kernel.unprivileged_userns_clone=1\n"; + print STDERR "I: or permanently enable unprivileged usernamespaces by putting the setting into /etc/sysctl.d/\n"; + } + return 0; + } + return 1; +} + +# tar cannot figure out the decompression program when receiving data on +# standard input, thus we do it ourselves. This is copied from tar's +# src/suffix.c +sub get_tar_compress_options($) { + my $filename = shift; + if ($filename =~ /\.(gz|tgz|taz)$/) { + return ('--gzip'); + } elsif ($filename =~ /\.(Z|taZ)$/) { + return ('--compress'); + } elsif ($filename =~ /\.(bz2|tbz|tbz2|tz2)$/) { + return ('--bzip2'); + } elsif ($filename =~ /\.lz$/) { + return ('--lzip'); + } elsif ($filename =~ /\.(lzma|tlz)$/) { + return ('--lzma'); + } elsif ($filename =~ /\.lzo$/) { + return ('--lzop'); + } elsif ($filename =~ /\.lz4$/) { + return ('--use-compress-program', 'lz4'); + } elsif ($filename =~ /\.(xz|txz)$/) { + return ('--xz'); + } elsif ($filename =~ /\.zst$/) { + return ('--zstd'); + } + return (); +} + +1; diff --git a/lib/Sbuild/XaptResolver.pm b/lib/Sbuild/XaptResolver.pm new file mode 100644 index 0000000..e25f644 --- /dev/null +++ b/lib/Sbuild/XaptResolver.pm @@ -0,0 +1,107 @@ +# ResolverBase.pm: build library for sbuild +# Copyright © 2005 Ryan Murray <rmurray@debian.org> +# Copyright © 2005-2008 Roger Leigh <rleigh@debian.org> +# Copyright © 2008 Simon McVittie <smcv@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 +# <http://www.gnu.org/licenses/>. +# +####################################################################### + +package Sbuild::XaptResolver; + +use strict; +use warnings; + +use Sbuild qw(debug); +use Sbuild::Base; +use Sbuild::ResolverBase; + +BEGIN { + use Exporter (); + our (@ISA, @EXPORT); + + @ISA = qw(Exporter Sbuild::ResolverBase); + + @EXPORT = qw(); +} + +sub new { + my $class = shift; + my $conf = shift; + my $session = shift; + my $host = shift; + + my $self = $class->SUPER::new($conf, $session, $host); + bless($self, $class); + + return $self; +} + +sub install_deps { + my $self = shift; + my $name = shift; + my @pkgs = @_; + + my $status = 0; + my $session = $self->get('Session'); +# my $dummy_pkg_name = 'sbuild-build-depends-' . $name. '-dummy'; + + # Call functions to setup an archive to install dummy package. +# return 0 unless ($self->setup_apt_archive($dummy_pkg_name, @pkgs)); +# return 0 unless (!$self->update_archive()); + + + $self->log_subsection("Install $name cross-build dependencies (xapt-based resolver)"); + + # Install the dummy package + my (@instd, @rmvd); + $self->log("Installing cross-build dependencies\n"); + if (!$self->run_xapt("-a", $self->get_conf('HOST_ARCH'), @pkgs)) { + $self->log("Package installation failed\n"); + if (defined ($self->get('Session')->get('Session Purged')) && + $self->get('Session')->get('Session Purged') == 1) { + $self->log("Not removing build depends: cloned chroot in use\n"); + } else { + $self->set_installed(@instd); + $self->set_removed(@rmvd); + goto package_cleanup; + } + return 0; + } + $self->set_installed(@instd); + $self->set_removed(@rmvd); + $status = 1; + + package_cleanup: + if ($status == 0) { + if (defined ($session->get('Session Purged')) && + $session->get('Session Purged') == 1) { + $self->log("Not removing installed packages: cloned chroot in use\n"); + } else { + $self->uninstall_deps(); + } + } + + return $status; +} + +sub purge_extra_packages { + my $self = shift; + my $name = shift; + + $self->log_error('Xapt resolver doesn\'t implement purging of extra packages yet.\n'); +} + +1; |