1	#!/usr/bin/perl -w
     2	# This file was preprocessed, do not edit!
     3	
     4	
     5	package Debconf::Question;
     6	use strict;
     7	use Debconf::Db;
     8	use Debconf::Template;
     9	use Debconf::Iterator;
    10	use Debconf::Log qw(:all);
    11	
    12	
    13	use fields qw(name priority);
    14	
    15	our %question;
    16	
    17	
    18	sub new {
    19		my Debconf::Question $this=shift;
    20		my $name=shift;
    21		my $owner=shift;
    22		my $type=shift || die "no type given for question";
    23		die "A question called \"$name\" already exists"
    24			if exists $question{$name};
    25		unless (ref $this) {
    26			$this = fields::new($this);
    27		}
    28		$this->{name}=$name;
    29		return unless defined $this->addowner($owner, $type);
    30		$this->flag('seen', 'false');
    31		return $question{$name}=$this;
    32	}
    33	
    34	
    35	sub get {
    36		my Debconf::Question $this=shift;
    37		my $name=shift;
    38		return $question{$name} if exists $question{$name};
    39		if ($Debconf::Db::config->exists($name)) {
    40			$this = fields::new($this);
    41			$this->{name}=$name;
    42			return $question{$name}=$this;
    43		}
    44		return undef;
    45	}
    46	
    47	
    48	sub iterator {
    49		my $this=shift;
    50	
    51		my $real_iterator=$Debconf::Db::config->iterator;
    52		return Debconf::Iterator->new(callback => sub {
    53			return unless my $name=$real_iterator->iterate;
    54			return $this->get($name);
    55		});
    56	}
    57	
    58	
    59	sub _expand_vars {
    60		my $this=shift;
    61		my $text=shift;
    62			
    63		return '' unless defined $text;
    64	
    65		my @vars=$Debconf::Db::config->variables($this->{name});
    66		
    67		my $rest=$text;
    68		my $result='';
    69		my $variable;
    70		my $varval;
    71		my $escape;
    72		while ($rest =~ m/^(.*?)(\\)?\${([^{}]+)}(.*)$/sg) {
    73			$result.=$1;  # copy anything before the variable
    74			$escape=$2;
    75			$variable=$3;
    76			$rest=$4; # continue trying to expand rest of text
    77			if (defined $escape && length $escape) {
    78				$result.="\${$variable}";
    79			}
    80			else {
    81				$varval=$Debconf::Db::config->getvariable($this->{name}, $variable);
    82				$result.=$varval if defined($varval); # expand the variable
    83			}
    84		}
    85		$result.=$rest; # add on anything that's left.
    86		
    87		return $result;
    88	}
    89	
    90	
    91	sub description {
    92		my $this=shift;
    93		return $this->_expand_vars($this->template->description);
    94	}
    95	
    96	
    97	sub extended_description {
    98		my $this=shift;
    99		return $this->_expand_vars($this->template->extended_description);
   100	}
   101	
   102	
   103	sub choices {
   104		my $this=shift;
   105		
   106		return $this->_expand_vars($this->template->choices);
   107	}
   108	
   109	
   110	sub choices_split {
   111		my $this=shift;
   112		
   113		my @items;
   114		my $item='';
   115		for my $chunk (split /(\\[, ]|,\s+)/, $this->choices) {
   116			if ($chunk=~/^\\([, ])$/) {
   117				$item.=$1;
   118			} elsif ($chunk=~/^,\s+$/) {
   119				push @items, $item;
   120				$item='';
   121			} else {
   122				$item.=$chunk;
   123			}
   124		}
   125		push @items, $item if $item ne '';
   126		return @items;
   127	}
   128	
   129	
   130	sub variable {
   131		my $this=shift;
   132		my $var=shift;
   133		
   134		if (@_) {
   135			return $Debconf::Db::config->setvariable($this->{name}, $var, shift);
   136		}
   137		else {
   138			return $Debconf::Db::config->getvariable($this->{name}, $var);
   139		}
   140	}
   141	
   142	
   143	sub flag {
   144		my $this=shift;
   145		my $flag=shift;
   146	
   147		if ($flag eq 'isdefault') {
   148			debug developer => "The isdefault flag is deprecated, use the seen flag instead";
   149			if (@_) {
   150				my $value=(shift eq 'true') ? 'false' : 'true';
   151				$Debconf::Db::config->setflag($this->{name}, 'seen', $value);
   152			}
   153			return ($Debconf::Db::config->getflag($this->{name}, 'seen') eq 'true') ? 'false' : 'true';
   154		}
   155	
   156		if (@_) {
   157			return $Debconf::Db::config->setflag($this->{name}, $flag, shift);
   158		}
   159		else {
   160			return $Debconf::Db::config->getflag($this->{name}, $flag);
   161		}
   162	}
   163	
   164	
   165	sub value {
   166		my $this = shift;
   167		
   168		unless (@_) {
   169			my $ret=$Debconf::Db::config->getfield($this->{name}, 'value');
   170			return $ret if defined $ret;
   171			return $this->template->default if ref $this->template;
   172		} else {
   173			return $Debconf::Db::config->setfield($this->{name}, 'value', shift);
   174		}
   175	}
   176	
   177	
   178	sub value_split {
   179		my $this=shift;
   180		
   181		my $value=$this->value;
   182		$value='' if ! defined $value;
   183		my @items;
   184		my $item='';
   185		for my $chunk (split /(\\[, ]|,\s+)/, $value) {
   186			if ($chunk=~/^\\([, ])$/) {
   187				$item.=$1;
   188			} elsif ($chunk=~/^,\s+$/) {
   189				push @items, $item;
   190				$item='';
   191			} else {
   192				$item.=$chunk;
   193			}
   194		}
   195		push @items, $item if $item ne '';
   196		return @items;
   197	}
   198	
   199	
   200	sub addowner {
   201		my $this=shift;
   202	
   203		return $Debconf::Db::config->addowner($this->{name}, shift, shift);
   204	}
   205	
   206	
   207	sub removeowner {
   208		my $this=shift;
   209	
   210		my $template=$Debconf::Db::config->getfield($this->{name}, 'template');
   211		return unless $Debconf::Db::config->removeowner($this->{name}, shift);
   212		if (length $template and 
   213		    not $Debconf::Db::config->exists($this->{name})) {
   214			$Debconf::Db::templates->removeowner($template, $this->{name});
   215			delete $question{$this->{name}};
   216		}
   217	}
   218	
   219	
   220	sub owners {
   221		my $this=shift;
   222	
   223		return join(", ", sort($Debconf::Db::config->owners($this->{name})));
   224	}
   225	
   226	
   227	sub template {
   228		my $this=shift;
   229		if (@_) {
   230			my $oldtemplate=$Debconf::Db::config->getfield($this->{name}, 'template');
   231			my $newtemplate=shift;
   232			if (not defined $oldtemplate or $oldtemplate ne $newtemplate) {
   233				$Debconf::Db::templates->removeowner($oldtemplate, $this->{name})
   234					if defined $oldtemplate and length $oldtemplate;
   235	
   236				$Debconf::Db::config->setfield($this->{name}, 'template', $newtemplate);
   237	
   238				$Debconf::Db::templates->addowner($newtemplate, $this->{name},
   239					$Debconf::Db::templates->getfield($newtemplate, "type"));
   240			}
   241		}
   242		return Debconf::Template->get(
   243			$Debconf::Db::config->getfield($this->{name}, 'template'));
   244	}
   245	
   246	
   247	sub name {
   248		my $this=shift;
   249	
   250		return $this->{name};
   251	}
   252	
   253	
   254	sub priority {
   255		my $this=shift;
   256	
   257		$this->{priority}=shift if @_;
   258	
   259		return $this->{priority};
   260	}
   261	
   262	
   263	sub AUTOLOAD {
   264		(my $field = our $AUTOLOAD) =~ s/.*://;
   265	
   266		no strict 'refs';
   267		*$AUTOLOAD = sub {
   268			my $this=shift;
   269	
   270			if (@_) {
   271				return $Debconf::Db::config->setfield($this->{name}, $field, shift);
   272			}
   273			my $ret=$Debconf::Db::config->getfield($this->{name}, $field);
   274			unless (defined $ret) {
   275				$ret = $this->template->$field() if ref $this->template;
   276			}
   277			if (defined $ret) {
   278				if ($field =~ /^(?:description|extended_description|choices)-/i) {
   279					return $this->_expand_vars($ret);
   280				} else {
   281					return $ret;
   282				}
   283			}
   284		};
   285		goto &$AUTOLOAD;
   286	}
   287	
   288	sub DESTROY {
   289	}
   290	
   291	
   292	1
   293	#!/usr/bin/perl -w
   294	# This file was preprocessed, do not edit!
   295	
   296	
   297	package Debconf::Config;
   298	use strict;
   299	use Debconf::Question;
   300	use Debconf::Gettext;
   301	use Debconf::Priority qw(priority_valid priority_list);
   302	use Debconf::Log qw(warn);
   303	use Debconf::Db;
   304	
   305	use fields qw(config templates frontend frontend_forced priority terse reshow
   306	              admin_email log debug nowarnings smileys sigils
   307	              noninteractive_seen c_values);
   308	our $config=fields::new('Debconf::Config');
   309	
   310	our @config_files=("/etc/debconf.conf", "/usr/share/debconf/debconf.conf");
   311	if ($ENV{DEBCONF_SYSTEMRC}) {
   312		unshift @config_files, $ENV{DEBCONF_SYSTEMRC};
   313	} else {
   314		unshift @config_files, ((getpwuid($>))[7])."/.debconfrc";
   315	}
   316		   
   317	
   318	sub _hashify ($$) {
   319		my $text=shift;
   320		my $hash=shift;
   321	
   322		$text =~ s/\${([^}]+)}/$ENV{$1}/eg;
   323		
   324		my %ret;
   325		my $i;
   326		foreach my $line (split /\n/, $text) {
   327			next if $line=~/^\s*#/; # comment
   328			next if $line=~/^\s*$/; # blank
   329			$line=~s/^\s+//;
   330			$line=~s/\s+$//;
   331			$i++;
   332			my ($key, $value)=split(/\s*:\s*/, $line, 2);
   333			$key=~tr/-/_/;
   334			die "Parse error" unless defined $key and length $key;
   335			$hash->{lc($key)}=$value;
   336		}
   337		return $i;
   338	}
   339	 
   340	sub _env_to_driver {
   341		my $value=shift;
   342		
   343		my ($name, $options) = $value =~ m/^(\w+)(?:{(.*)})?$/;
   344		return unless $name;
   345		
   346		return $name if Debconf::DbDriver->driver($name);
   347		
   348		my %hash = @_; # defaults from params
   349		$hash{driver} = $name;
   350		
   351		if (defined $options) {
   352			foreach (split ' ', $options) {
   353				if (/^(\w+):(.*)/) {
   354					$hash{$1}=$2;
   355				}
   356				else {
   357					$hash{filename}=$_;
   358				}
   359			}
   360		}
   361		return Debconf::Db->makedriver(%hash)->{name};
   362	}
   363	
   364	sub load {
   365		my $class=shift;
   366		my $cf=shift;
   367		my @defaults=@_;
   368		
   369		if (! $cf) {
   370			for my $file (@config_files) {
   371				$cf=$file, last if -e $file;
   372			}
   373		}
   374		die "No config file found" unless $cf;
   375	
   376		open (DEBCONF_CONFIG, $cf) or die "$cf: $!\n";
   377		local $/="\n\n"; # read a stanza at a time
   378	
   379		1 until _hashify(<DEBCONF_CONFIG>, $config) || eof DEBCONF_CONFIG;
   380	
   381		if (! exists $config->{config}) {
   382			print STDERR "debconf: ".gettext("Config database not specified in config file.")."\n";
   383			exit(1);
   384		}
   385		if (! exists $config->{templates}) {
   386			print STDERR "debconf: ".gettext("Template database not specified in config file.")."\n";
   387			exit(1);
   388		}
   389	
   390		if (exists $config->{sigils} || exists $config->{smileys}) {
   391			print STDERR "debconf: ".gettext("The Sigils and Smileys options in the config file are no longer used. Please remove them.")."\n";
   392		}
   393	
   394		while (<DEBCONF_CONFIG>) {
   395			my %config=(@defaults);
   396			if (exists $ENV{DEBCONF_DB_REPLACE}) {
   397				$config{readonly} = "true";
   398			}
   399			next unless _hashify($_, \%config);
   400			eval {
   401				Debconf::Db->makedriver(%config);
   402			};
   403			if ($@) {
   404				print STDERR "debconf: ".sprintf(gettext("Problem setting up the database defined by stanza %s of %s."),$., $cf)."\n";
   405				die $@;
   406			}
   407		}
   408		close DEBCONF_CONFIG;
   409	
   410		if (exists $ENV{DEBCONF_DB_REPLACE}) {
   411			$config->{config} = _env_to_driver($ENV{DEBCONF_DB_REPLACE},
   412				name => "_ENV_REPLACE");
   413			Debconf::Db->makedriver(
   414				driver => "Pipe",
   415				name => "_ENV_REPLACE_templates",
   416				infd => "none",
   417				outfd => "none",
   418			);
   419			my @template_stack = ("_ENV_REPLACE_templates", $config->{templates});
   420			Debconf::Db->makedriver(
   421				driver => "Stack",
   422				name => "_ENV_stack_templates",
   423				stack => join(", ", @template_stack),
   424			);
   425			$config->{templates} = "_ENV_stack_templates";
   426		}
   427	
   428		my @finalstack = ($config->{config});
   429		if (exists $ENV{DEBCONF_DB_OVERRIDE}) {
   430			unshift @finalstack, _env_to_driver($ENV{DEBCONF_DB_OVERRIDE},
   431				name => "_ENV_OVERRIDE");
   432		}
   433		if (exists $ENV{DEBCONF_DB_FALLBACK}) {
   434			push @finalstack, _env_to_driver($ENV{DEBCONF_DB_FALLBACK},
   435				name => "_ENV_FALLBACK",
   436				readonly => "true");
   437		}
   438		if (@finalstack > 1) {
   439			Debconf::Db->makedriver(
   440				driver => "Stack",
   441				name => "_ENV_stack",
   442				stack  => join(", ", @finalstack),
   443			);
   444			$config->{config} = "_ENV_stack";
   445		}
   446	}
   447	
   448	
   449	sub getopt {
   450		my $class=shift;
   451		my $usage=shift;
   452	
   453		my $showusage=sub { # closure
   454			print STDERR $usage."\n";
   455			print STDERR gettext(<<EOF);
   456	  -f,  --frontend		Specify debconf frontend to use.
   457	  -p,  --priority		Specify minimum priority question to show.
   458	       --terse			Enable terse mode.
   459	EOF
   460			exit 1;
   461		};
   462	
   463		return unless grep { $_ =~ /^-/ } @ARGV;
   464		
   465		require Getopt::Long;
   466		Getopt::Long::Configure('bundling');
   467		Getopt::Long::GetOptions(
   468			'frontend|f=s',	sub { shift; $class->frontend(shift); $config->frontend_forced(1) },
   469			'priority|p=s',	sub { shift; $class->priority(shift) },
   470			'terse',	sub { $config->{terse} = 'true' },
   471			'help|h',	$showusage,
   472			@_,
   473		) || $showusage->();
   474	}
   475	
   476	
   477	sub frontend {
   478		my $class=shift;
   479		
   480		return $ENV{DEBIAN_FRONTEND} if exists $ENV{DEBIAN_FRONTEND};
   481		$config->{frontend}=shift if @_;
   482		return $config->{frontend} if exists $config->{frontend};
   483		
   484		my $ret='dialog';
   485		my $question=Debconf::Question->get('debconf/frontend');
   486		if ($question) {
   487			$ret=lcfirst($question->value) || $ret;
   488		}
   489		return $ret;
   490	}
   491	
   492	
   493	sub frontend_forced {
   494		my ($class, $val) = @_;
   495		$config->{frontend_forced} = $val
   496			if defined $val || exists $ENV{DEBIAN_FRONTEND};
   497		return $config->{frontend_forced} ? 1 : 0;
   498	}
   499	
   500	
   501	sub priority {
   502		my $class=shift;
   503		return $ENV{DEBIAN_PRIORITY} if exists $ENV{DEBIAN_PRIORITY};
   504		if (@_) {
   505			my $newpri=shift;
   506			if (! priority_valid($newpri)) {
   507				warn(sprintf(gettext("Ignoring invalid priority \"%s\""), $newpri));
   508				warn(sprintf(gettext("Valid priorities are: %s"), join(" ", priority_list())));
   509			}
   510			else {
   511				$config->{priority}=$newpri;
   512			}
   513		}
   514		return $config->{priority} if exists $config->{priority};
   515	
   516		my $ret='high';
   517		my $question=Debconf::Question->get('debconf/priority');
   518		if ($question) {
   519			$ret=$question->value || $ret;
   520		}
   521		return $ret;
   522	}
   523	
   524	
   525	sub terse {
   526		my $class=shift;
   527		return $ENV{DEBCONF_TERSE} if exists $ENV{DEBCONF_TERSE};
   528		$config->{terse}=$_[0] if @_;
   529		return $config->{terse} if exists $config->{terse};
   530		return 'false';
   531	}
   532	
   533	
   534	sub nowarnings {
   535		my $class=shift;
   536		return $ENV{DEBCONF_NOWARNINGS} if exists $ENV{DEBCONF_NOWARNINGS};
   537		$config->{nowarnings}=$_[0] if @_;
   538		return $config->{nowarnings} if exists $config->{nowarnings};
   539		return 'false';
   540	}
   541	
   542	
   543	sub debug {
   544		my $class=shift;
   545		return $ENV{DEBCONF_DEBUG} if exists $ENV{DEBCONF_DEBUG};
   546		return $config->{debug} if exists $config->{debug};
   547		return '';
   548	}
   549	
   550	
   551	sub admin_email {
   552		my $class=shift;
   553		return $ENV{DEBCONF_ADMIN_EMAIL} if exists $ENV{DEBCONF_ADMIN_EMAIL};
   554		return $config->{admin_email} if exists $config->{admin_email};
   555		return 'root';
   556	}
   557	
   558	
   559	sub noninteractive_seen {
   560		my $class=shift;
   561		return $ENV{DEBCONF_NONINTERACTIVE_SEEN} if exists $ENV{DEBCONF_NONINTERACTIVE_SEEN};
   562		return $config->{noninteractive_seen} if exists $config->{noninteractive_seen};
   563		return 'false';
   564	}
   565	
   566	
   567	sub c_values {
   568		my $class=shift;
   569		return $ENV{DEBCONF_C_VALUES} if exists $ENV{DEBCONF_C_VALUES};
   570		return $config->{c_values} if exists $config->{c_values};
   571		return 'false';
   572	}
   573	
   574	
   575	sub AUTOLOAD {
   576		(my $field = our $AUTOLOAD) =~ s/.*://;
   577		my $class=shift;
   578		
   579		return $config->{$field}=shift if @_;
   580		return $config->{$field} if defined $config->{$field};
   581		return '';
   582	}
   583	
   584	
   585	1