Description: validate format/driver names before eval STRING in DbDrivers
 Debconf::DbDriver::{File,Directory,Pipe}::init() and
 Debconf::Db::makedriver() splice an attacker-influenced string
 directly into a Perl `eval STRING`:
 .
   Debconf/DbDriver/File.pm        eval "use Debconf::Format::$this->{format}";
   Debconf/DbDriver/Directory.pm   eval "use Debconf::Format::$this->{format}";
   Debconf/DbDriver/Pipe.pm        eval "use Debconf::Format::$this->{format}";
   Debconf/Db.pm                   eval qq{use Debconf::DbDriver::$type};
 .
 The string is the `format:` (or `Driver:`) value parsed out of the
 debconf database configuration.  No validation precedes the eval, so
 a value such as
   format:822;BEGIN{qx(touch /tmp/dconf_repro)};1
 makes the eval text  use Debconf::Format::822;BEGIN{qx(touch ...)};1
 and the second BEGIN{} runs at compile time as the perl process
 UID/EUID.
 .
 Eight runtime-confirmed trigger combinations on Debian sid
 (debconf 1.5.92) all reach this primitive (DEBCONF_DB_OVERRIDE /
 FALLBACK / REPLACE; DEBCONF_SYSTEMRC config-file; DPKG_ROOT
 prefix; ${VAR} env-substitution in the parsed stanza body
 transporting the malicious value).
 .
 This patch validates `$this->{format}` and `$type` against
 `\A[A-Za-z0-9_]+\z` immediately before each eval.  The shipped
 Format module name `822` matches the regex, so legitimate
 configurations continue to work; any value carrying `;`, `{`,
 whitespace, `/`, etc. is rejected with a clear error before the
 eval can run.
 .
 No change is made to Debconf::Config to keep the diff minimal and
 to avoid touching the documented (if rarely used) ${VAR}
 substitution in stanza bodies; that route is closed at the eval
 sink instead.  A separate Config.pm hardening patch can be
 prepared if maintainers prefer to also restrict the substitution
 layer.

Author: Jeremy Erazo (Devel Group) <mendozayt13@gmail.com>
Forwarded: not-yet
Last-Update: 2026-05-07

diff -urN a/Debconf/DbDriver/Directory.pm b/Debconf/DbDriver/Directory.pm
--- a/Debconf/DbDriver/Directory.pm	2026-05-07 16:00:00.000000000 +0000
+++ b/Debconf/DbDriver/Directory.pm	2026-05-07 16:00:00.000000000 +0000
@@ -68,6 +68,10 @@
 	$this->{backup} = 1 unless exists $this->{backup};

 	$this->error("No format specified") unless $this->{format};
+	if ((!defined $this->{format}) || ($this->{format} !~ /\A[A-Za-z0-9_]+\z/)) {
+		$this->error("Invalid Format value: must match [A-Za-z0-9_]+");
+		return;
+	}
 	eval "use Debconf::Format::$this->{format}";
 	if ($@) {
 		$this->error("Error setting up format object $this->{format}: $@");
diff -urN a/Debconf/DbDriver/File.pm b/Debconf/DbDriver/File.pm
--- a/Debconf/DbDriver/File.pm	2026-05-07 16:00:00.000000000 +0000
+++ b/Debconf/DbDriver/File.pm	2026-05-07 16:00:00.000000000 +0000
@@ -72,6 +72,10 @@
 	$this->{backup} = 1 unless exists $this->{backup};

 	$this->error("No format specified") unless $this->{format};
+	if ((!defined $this->{format}) || ($this->{format} !~ /\A[A-Za-z0-9_]+\z/)) {
+		$this->error("Invalid Format value: must match [A-Za-z0-9_]+");
+		return;
+	}
 	eval "use Debconf::Format::$this->{format}";
 	if ($@) {
 		$this->error("Error setting up format object $this->{format}: $@");
diff -urN a/Debconf/DbDriver/Pipe.pm b/Debconf/DbDriver/Pipe.pm
--- a/Debconf/DbDriver/Pipe.pm	2026-05-07 16:00:00.000000000 +0000
+++ b/Debconf/DbDriver/Pipe.pm	2026-05-07 16:00:00.000000000 +0000
@@ -63,6 +63,10 @@
 	$this->{format} = "822" unless exists $this->{format};

 	$this->error("No format specified") unless $this->{format};
+	if ((!defined $this->{format}) || ($this->{format} !~ /\A[A-Za-z0-9_]+\z/)) {
+		$this->error("Invalid Format value: must match [A-Za-z0-9_]+");
+		return;
+	}
 	eval "use Debconf::Format::$this->{format}";
 	if ($@) {
 		$this->error("Error setting up format object $this->{format}: $@");
diff -urN a/Debconf/Db.pm b/Debconf/Db.pm
--- a/Debconf/Db.pm	2026-05-07 16:00:00.000000000 +0000
+++ b/Debconf/Db.pm	2026-05-07 16:00:00.000000000 +0000
@@ -67,6 +67,9 @@

 	# Make sure that the class is loaded..
 	if (! UNIVERSAL::can("Debconf::DbDriver::$type", 'new')) {
+		if ($type !~ /\A[A-Za-z0-9_]+\z/) {
+			die "Invalid DbDriver name '$type': must match [A-Za-z0-9_]+";
+		}
 		eval qq{use Debconf::DbDriver::$type};
 		die $@ if $@;
 	}