#!/usr/bin/perl -w

=head1 NAME

dpkg-reconfigure - reconfigure an already installed package

=head1 SYNOPSIS

 dpkg-reconfigure [options] packages

=head1 DESCRIPTION

B<dpkg-reconfigure> reconfigures packages after they have already been
installed. Pass it the names of a package or packages to reconfigure. It
will ask configuration questions, much like when the package was first
installed.

If you just want to see the current configuration of a package, see
L<debconf-show(1)> instead.

=head1 OPTIONS

=over 4

=item B<-f>I<type>, B<--frontend=>I<type>

Select the frontend to use. The default frontend can be permanently changed
by:

 dpkg-reconfigure debconf

Note that if you normally have debconf set to use the noninteractive
frontend, dpkg-reconfigure will use the dialog frontend instead, so you
actually get to reconfigure the package.

=item B<-p>I<value>, B<--priority=>I<value>

Specify the minimum priority of question that will be displayed.
dpkg-reconfigure normally shows low priority questions no matter what your
default priority is. See L<debconf(7)> for a list.

=item B<--default-priority>

Use whatever the default priority of question is, instead of forcing the
priority to low.

=item B<-u>, B<--unseen-only>

By default, all questions are shown, even if they have already been
answered. If this parameter is set though, only questions that have not yet
been seen will be asked.

=item B<--force>

Force dpkg-reconfigure to reconfigure a package even if the package is in an
inconsistent or broken state. Use with caution.

=item B<--no-reload>

Prevent dpkg-reconfigure from reloading templates. Use with caution; this
will prevent dpkg-reconfigure from repairing broken templates databases.
However, it may be useful in constrained environments where rewriting the
templates database is expensive.

=item B<-h>, B<--help>

Display usage help.

=back

=cut

=head1 SEE ALSO

L<debconf(7)>

=cut

if (exists $ENV{DEBCONF_USE_CDEBCONF} and $ENV{DEBCONF_USE_CDEBCONF} ne '') {
    exec "/usr/lib/cdebconf/dpkg-reconfigure", @ARGV;
}

use strict;
use Cwd;
use Debconf::Db;
use Debconf::Gettext;
use Debconf::Template;
use Debconf::Config;
use Debconf::AutoSelect qw(:all);
use Debconf::Log qw(:all);

# Use low priority unless an option below overrides.
Debconf::Config->priority('low');

my $unseen_only=0;
my $force=0;
my $default_priority=0;
my $reload=1;
Debconf::Config->getopt(
gettext(qq{Usage: dpkg-reconfigure [options] packages
  -u,  --unseen-only		Show only not yet seen questions.
       --default-priority	Use default priority instead of low.
       --force			Force reconfiguration of broken packages.
       --no-reload		Do not reload templates. (Use with caution.)}),
	"unseen-only|u"		=> \$unseen_only,
	"default-priority"	=> \$default_priority,
	"force"			=> \$force,
	"reload!"		=> \$reload,
);

if ($> != 0) {
	print STDERR sprintf(gettext("%s must be run as root"), $0)."\n";
	exit 1;
}

Debconf::Db->load;

if ($default_priority) {
	Debconf::Config->priority(Debconf::Question->get('debconf/priority')->value);
}

# If the frontend is noninteractive, change it temporarily to dialog.
if (lc Debconf::Config->frontend eq 'noninteractive' &&
    ! Debconf::Config->frontend_forced) {
	Debconf::Config->frontend('dialog');
}

my $frontend=make_frontend();

unless ($unseen_only) {
	# Make the frontend show questions even if the user has already seen
	# them. Since this is a reconfigure program, they may want to change
	# their choices.
	Debconf::Config->reshow(1);
}

my @packages=@ARGV;
if (! @packages) {
	print STDERR "$0: ".gettext("please specify a package to reconfigure")."\n";
	exit 1;
}

# This is a hack to let postinsts know when they're being reconfigured. It
# would of course be better to pass them "reconfigure", but we can't for
# hysterical raisens.
$ENV{DEBCONF_RECONFIGURE}=1;

my %initial_triggers=map { $_ => 1 } triggers_pending();

my $original_cwd=getcwd();

foreach my $pkg (@packages) {
	# Set default title.
	$frontend->default_title($pkg);
	$frontend->info(undef);

	# Get the package version. Also check to make sure it is installed.
	$_=`dpkg --status $pkg`;
	my ($version)=m/Version: (.*)\n/;
	my ($status)=m/Status: (.*)\n/;
	my ($package)=m/Package: (.*)\n/;
	my ($arch)=m/Architecture: (.*)\n/;
	if (! $force) {
		if (! defined $status || $status =~ m/not-installed$/) {
			print STDERR "$0: ".sprintf(gettext("%s is not installed"), $pkg)."\n";
			exit 1;
		}
		if ($status !~ m/ ok installed$/) {
			print STDERR "$0: ".sprintf(gettext("%s is broken or not fully installed"), $pkg)."\n";
			exit 1;
		}
	}
	
	my @control_paths=`dpkg-query --control-path $pkg`;
	map chomp, @control_paths;
	my $control_path = sub {
		my $file = shift;
		my $path = (grep /\.\Q$file\E$/, @control_paths)[0];
		chomp($path) if defined $path;
		return $path;
	};

	if ($reload) {
		# Load up templates just in case they aren't already.
		my $templates=$control_path->('templates');
		if ($templates and -e $templates) {
			Debconf::Template->load($templates, $pkg);
		}
	}

	# Simulation of reinstalling a package, without bothering with
	# removing the files and putting them back. Just like in a regular
	# reinstall, run config, and postinst scripts in sequence, with args.
	# Do not run postrm, because the postrm can depend on the package's
	# files actually being gone already.
	foreach my $info (['prerm',    'upgrade',     $version],
		          ['config',   'reconfigure', $version],
			  ['postinst', 'configure',   $version]) {
		my $script=shift @$info;
		my $path_script=$control_path->($script);

		next unless $path_script and -x $path_script;

		my $is_confmodule='';

		# Set environment variables expected by maintainer scripts
		$ENV{DPKG_MAINTSCRIPT_PACKAGE}=$package;
		$ENV{DPKG_MAINTSCRIPT_ARCH}=$arch;
		$ENV{DPKG_MAINTSCRIPT_NAME}=$script;

		if ($script ne 'config') {
			# Test to see if the script uses debconf.
			open (IN, "<$path_script");
			while (<IN>) {
				if (/confmodule/i) {
					$is_confmodule=1;
					last;
				}
			}
			close IN;
		}
		
		chdir('/');
		if ($script eq 'config' || $is_confmodule) {
			# Start up the confmodule.
			my $confmodule=make_confmodule($path_script, @$info);
	
			# Make sure any questions the confmodule registers
			# are owned by this package.
			$confmodule->owner($pkg);
		
			# Talk to it until it is done.
			1 while ($confmodule->communicate);
	
			exit $confmodule->exitcode if $confmodule->exitcode > 0;
		}
		else {
			# Not a confmodule, so run it as a normal script.
			run_external($path_script, @$info);
		}
		chdir($original_cwd);
	}
}

# Maintainer scripts may have activated triggers.  If so, try to process
# them.
my @new_triggers;
do {
	@new_triggers=();
	foreach my $trigpend (triggers_pending()) {
		push @new_triggers, $trigpend
			if not exists $initial_triggers{$trigpend};
	}
	if (@new_triggers) {
		chdir('/');
		run_external("dpkg", "--configure", @new_triggers);
		chdir($original_cwd);
	}
} while (@new_triggers);

$frontend->shutdown;

Debconf::Db->save;

# Run an external program that does not itself use debconf, but that may run
# other programs that do use debconf.  To do this safely, checkpoint the
# current database state and re-initialize it when the program finishes.
sub run_external {
	Debconf::Db->save;
	
	delete $ENV{DEBIAN_HAS_FRONTEND};
	my $ret=system(@_);
	if (int($ret / 256) != 0) {
		exit int($ret / 256);
	}
	$ENV{DEBIAN_HAS_FRONTEND}=1;
	
	Debconf::Db->load;
}

# Returns a list of all packages with pending triggers.
sub triggers_pending {
	my @ret;
	local $_;

	open (QUERY, '-|', 'dpkg-query', '-W',
		'-f', '${Package} ${binary:Package}\t${Triggers-Pending}\n');
	while (<QUERY>) {
		chomp;
		my ($pkgnames, $triggers) = split /\t/;
		if (length $triggers) {
			# Handle multiarch.
			my ($pkg, $binpkg) = split ' ', $pkgnames;
			push @ret, (length $binpkg ? $binpkg : $pkg);
		}
	}
	close QUERY;

	return @ret;
}

=head1 AUTHOR

Joey Hess <joeyh@debian.org>

=cut