1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
#!/usr/bin/perl
=head1 NAME
frontend - runs a debconf frontend
=head1 SYNOPSIS
frontend confmodule [params]
=head1 DESCRIPTION
This is a helper program for confmodules. It expects to be passed
the name of the confmodule script to run, and any parameters for it.
This whole thing is really a hack; in an ideal world, dpkg would handle
all this.
=cut
use warnings;
use strict;
use Debconf::Db;
use Debconf::Template;
use Debconf::AutoSelect qw(:all);
use Debconf::Log qw(:all);
Debconf::Db->load;
debug developer => "frontend started";
my $frontend=make_frontend();
shift @ARGV if $ARGV[0] eq '--';
# Set the default title.
my $package;
my $no_title=0;
my $root=$ENV{DPKG_ROOT} // '';
if ($ENV{DEBCONF_PACKAGE}) {
$package=$ENV{DEBCONF_PACKAGE};
}
elsif ($ARGV[0]=~m!^.*/(.*?)\.(?:postinst|postrm|prerm)$!) {
$package=$1;
my $action=$ARGV[1];
# Avoid spurious title updates with triggered actions:
$no_title=1 if $action eq 'triggered';
}
elsif (-e "$root/var/lib/dpkg/tmp.ci/control") {
# The preinst is running, presumably. Now it gets really ugly, because
# I have to parse the control file.
open (my $control, "<", "$root/var/lib/dpkg/tmp.ci/control")
|| die "Debconf: unable to open control file: $!";
while (<$control>) {
if (/^Package: (.*)/) {
$package=$1;
last;
}
}
close $control;
if (! exists $ENV{PERL_DL_NONLAZY} || ! $ENV{PERL_DL_NONLAZY}) {
warn "PERL_DL_NONLAZY is not set, if debconf is running from a preinst script, this is not safe";
}
}
else {
# Being run some other way, not via a dpkg script.
$package='';
debug developer => 'Trying to find a templates file..';
sub trytemplate {
my $fn=shift;
debug developer => "Trying $fn";
if (-e $fn) {
debug developer => "I guess it is $fn";
Debconf::Template->load($fn, $package);
return 1;
}
else {
return;
}
}
# See if there is a templates file in the same directory as the script,
# with the same name except .templates is appended.
unless (trytemplate("$ARGV[0].templates")) {
# Next try removing "config" from the end of the script name,
# and putting in "templates".
unless ($ARGV[0]=~m/(.*)config$/ && trytemplate("${1}templates")) {
# Finally, look in debconf lib directory for the base
# filename with .templates appended.
unless ($ARGV[0]=~m!^(?:.*/)?(.*)! && trytemplate("/usr/share/debconf/templates/${1}.templates")) {
debug developer => "Couldn't find a templates file."
}
}
}
}
debug developer => "frontend running, package name is $package";
$frontend->default_title($package) if length $package and not $no_title;
$frontend->info(undef);
# Load any associated templates if we're being run from a package maintainer
# script.
if ($ARGV[0] =~/^(.*[.\/])(?:preinst|postinst|prerm|postrm)$/) {
my $base=$1;
my $templates=$base."templates";
Debconf::Template->load($templates, $package)
if -e $templates;
}
# See if the preinst or postinst of the package is being run, and if there
# is a config script associated with this package. If so, run it first as a
# confmodule (also loading the templates). This is a bit of a nasty hack, that
# lets you dpkg -i somepackage.deb and have its config script be run first.
#
# If it is the preinst, everything is in this weird directory deep in
# /var/lib/dpkg.
if ($ARGV[0] =~/^(.*[.\/])(?:postinst|preinst)$/) {
my $base=$1;
# Run config script, if any.
my $config=$base."config";
if (-e $config) {
# I assume that the third argument passed to this
# program (which should be the second argument passed to the
# preinst or postinst that ran it), is the package version.
my $version=$ARGV[2];
if (! defined($version)) {
$version='';
}
my $confmodule=make_confmodule($config,
"configure", $version);
# Make sure any questions the confmodule generates
# are owned by this package.
$confmodule->owner($package);
# Talk to it until it is done.
1 while ($confmodule->communicate);
exit $confmodule->exitcode if $confmodule->exitcode > 0;
}
}
# Start up the confmodule we were asked to run.
my $confmodule=make_confmodule(@ARGV);
# Make sure any questions the confmodule generates are owned by this package.
$confmodule->owner($package);
# Talk to it until it is done.
1 while ($confmodule->communicate);
$frontend->shutdown;
# Save state.
Debconf::Db->save;
exit $confmodule->exitcode;
=head1 AUTHOR
Joey Hess <joeyh@debian.org>
=cut
|
