/usr/bin/debconf-set-selections-edu is in debian-edu-config 1.702.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
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 | #!/usr/bin/perl
# This file was copied from debconf version 1.5.36.1 to fix BTS
# #636219. It should be removed when this bug is fixed in Squeeze or
# we upgrade to Wheezy.
sub usage {
print STDERR <<EOF;
Usage: debconf-set-selections [-vcu] [file]
-v, --verbose verbose output
-c, --checkonly only check the input file format
-u, --unseen do not set the 'seen' flag when preseeding values
EOF
exit(1);
}
use warnings;
use strict;
use Debconf::Db;
use Debconf::Template;
use Getopt::Long;
use vars qw(%opts $filename $debug $error $checkonly $unseen);
sub info {
my $msg = shift;
print STDERR "info: $msg\n" if $debug;
}
sub warning {
my $msg = shift;
print STDERR "warning: $msg\n";
}
sub error {
my $msg = shift;
print STDERR "error: $msg\n";
$error++
}
sub load_answer {
my ($owner, $label, $type, $content) = @_;
info "Loading answer for '$label'";
my $template=Debconf::Template->get($label);
if (! $template) {
$template=Debconf::Template->new($label, $owner, $type);
$template->description("Dummy template");
$template->extended_description("This is a fake template used to pre-seed the debconf database. If you are seeing this, something is probably wrong.");
}
else {
$template->default($content);
}
$template->type($type);
my $question=Debconf::Question->get($label);
if (! $question) {
error("Cannot find a question for $label");
return;
}
$question->addowner($owner, $type);
$question->value($content);
if (! $unseen) {
$question->flag("seen", "true");
}
}
sub set_flag {
my ($owner, $label, $flag, $content) = @_;
info "Setting $flag flag";
my $question=Debconf::Question->get($label);
if (! $question) {
error("Cannot find a question for $label");
return;
}
$question->flag($flag, $content);
}
my @knowntypes = qw(select boolean string multiselect note password text title);
my @knownflags = qw(seen);
sub ok_format {
my ($owner, $label, $type, $content) = @_;
if (! defined $owner || ! defined $label || ! defined $content) {
error "parse error on line $.: '$_'";
return;
}
elsif (! grep { $_ eq $type } @knowntypes, @knownflags) {
warning "Unknown type $type, skipping line $.";
return;
}
else {
return 1;
}
}
sub mungeline ($) {
my $line=shift;
chomp $line;
$line=~s/^\#.*$//;
$line=~s/\r$//;
return $line;
}
GetOptions(
"verbose|v" => \$debug,
"checkonly|c" => \$checkonly,
"unseen|u" => \$unseen,
) || usage();
Debconf::Db->load;
$error = 0;
while (<>) {
$_=mungeline($_);
while (/\\$/ && ! eof) {
s/\\$//;
$_.=mungeline(<>);
}
next if /^\s*$/;
my ($owner, $label, $type, $content) = /^\s*(\S+)\s+(\S+)\s+(\S+)(?:\s(.*))?/;
if (! defined $content) {
$content='';
}
if (ok_format($owner, $label, $type, $content)) {
if (grep { $_ eq $type } @knownflags) {
info "Trying to set '$type' flag to '$content'";
set_flag($owner, $label, $type, $content);
}
else {
info "Trying to set '$label' [$type] to '$content'";
load_answer($owner, $label, $type, $content);
}
}
}
if (! $checkonly) {
Debconf::Db->save;
}
if ($error) {
exit 1;
}
|