Re: Introducing rlintian ("restricted lintian")
On 2013-04-21 19:32, Niels Thykier wrote:
> On 2013-04-21 19:03, Russ Allbery wrote:
>> [...]
>> Separately (and compatibly), I do think it would be very worthwhile to get
>> all of Lintian to run in taint mode, but that's a much bigger project.
>>
>
> I know it would be the "right thing to do", but I have to admit it
> sounds like a lot of work.
>
> ~Niels
>
> [...]
Obviously I had to try this. The attached patch makes lintian succeed
in -C changes-file checks[1]. I do not have a lot of experience with
tainting, so don't use it as reference material. :)
Lintian w. taint still blows up on anything that needs to be unpacked
(AFAICT, chdir is the big "sinner").
~Niels
[1] perl -T frontend/lintian --root . -EvIL +pedantic \
-C changes-file ../lintian_2.5.12_amd64.changes
diff --git a/frontend/lintian b/frontend/lintian
index 8f1ecde..ea2bb99 100755
--- a/frontend/lintian
+++ b/frontend/lintian
@@ -59,15 +59,7 @@ qw(
# - use q{} here because we use '' in the snippet to replace the
# the string (and escaping it would be a pain...)
my $LINTIAN_VERSION = q{<VERSION>}; #External Version number
-if ($LINTIAN_VERSION eq '<VERSION>') {
- # For some reason the version above has not be substituted.
- # Most likely this means we are a git clone or an unpacked
- # source package. If so, we will use a version that best
- # describes our situation...
- my $guess = _guess_version (__FILE__);
- $LINTIAN_VERSION = $guess if $guess;
-}
-my $BANNER = "Lintian v$LINTIAN_VERSION"; #Version Banner - text form
+my $BANNER; #Version Banner - text form (set later)
# Variables used to record commandline options
# Commented out variables have "defined" checks somewhere to determine if
@@ -134,11 +126,18 @@ $SIG{PIPE} = 'IGNORE';
$ENV{'LC_ALL'} = 'C';
# reset timezone definition (also for tar)
$ENV{'TZ'} = '';
+# reset path to a safe known default
+$ENV{PATH} = '/bin:/usr/bin';
-# When run in some automated ways, Lintian may not have a PATH, but we assume
-# we can call standard utilities without their full path. If PATH is
-# completely unset, add something basic.
-$ENV{PATH} = '/bin:/usr/bin' unless $ENV{PATH};
+if ($LINTIAN_VERSION eq '<VERSION>') {
+ # For some reason the version above has not be substituted.
+ # Most likely this means we are a git clone or an unpacked
+ # source package. If so, we will use a version that best
+ # describes our situation...
+ my $guess = _guess_version(__FILE__);
+ $LINTIAN_VERSION = $guess if $guess;
+}
+$BANNER = "Lintian v$LINTIAN_VERSION";
# }}}
@@ -566,7 +565,8 @@ if (defined $opt{'LINTIAN_ROOT'}) {
print STDERR "Cannot resolve $opt{'LINTIAN_ROOT'}: $!\n";
exit 2;
}
- $opt{'LINTIAN_ROOT'} = $resolved;
+ # We trust the provided LINTIAN_ROOT (we pretty much have to)
+ $opt{'LINTIAN_ROOT'} = untaint($resolved);
}
# --root/$ENV{LINTIAN_ROOT} implies --no-user-dirs (but allow
# the users to explicitly override that if they so desire)
@@ -577,7 +577,7 @@ if (defined $opt{'LINTIAN_ROOT'}) {
$opt{'user-dirs'} //= 1;
}
# exported for collections, which are run as an external process.
-$ENV{'LINTIAN_ROOT'} = $opt{'LINTIAN_ROOT'};
+$ENV{'LINTIAN_ROOT'} = $opt{'LINTIAN_ROOT'} = $opt{'LINTIAN_ROOT'};
# Filter out non-existent paths and resolve the rest.
# - as we will add them to @INC, make sure they are resolved
@@ -603,7 +603,8 @@ if ($opt{'user-dirs'} and not $ENV{'LINTIAN_INTERNAL_TESTSUITE'}){
# In some (rare) cases, $ENV{HOME} will not be available.
# - Handle that gracefully by not emitting "Uninitialized ...".
- unshift @restricted_search_dirs, "$ENV{HOME}/.lintian" if defined $ENV{HOME};
+ unshift @restricted_search_dirs, "$ENV{HOME}/.lintian"
+ if defined $ENV{HOME};
}
push @search_dirs, $opt{'LINTIAN_ROOT'};
@@ -655,8 +656,10 @@ $opt{'LINTIAN_PROFILE'} = 'debian/ftp-master-auto-reject' if $ftpmaster_tags;
# {{{ Loading lintian's own libraries, parse config file and setup output
# Include (only existsing) lib directories from @search_dirs in @INC
-
-unshift @INC, grep { -d } map { "$_/lib" } @search_dirs;
+# - we untaint these values unconditionally as we "trust" the
+# search dirs (we pretty much have to for the feature to
+# make sense).
+unshift @INC, grep { -d } map { untaint("$_/lib") } @search_dirs;
require Lintian::Lab;
@@ -1608,6 +1611,9 @@ sub _guess_version {
my $rootdir;
return '' unless $absfront;
$rootdir = File::Basename::dirname (File::Basename::dirname ($absfront));
+ # We believe it to be safe enough for our purpose (i.e. pass it to git
+ # or Parse::DebianChangelog)
+ $rootdir = untaint($rootdir);
if ( -d "$rootdir/.git" ) {
# Lets try git
@@ -1706,6 +1712,15 @@ sub interrupted {
die "N: Interrupted.\n";
}
+# This is a copy of the same function in L::Util (bad I know)
+sub untaint {
+ my ($val) = @_;
+ if ($val =~ m{\A ( .*+ ) \Z}xsm) {
+ return $1;
+ }
+ die qq{"$val" does not match the "match anything" pattern!?\n};
+}
+
# }}}
# Local Variables:
diff --git a/lib/Lintian/CheckScript.pm b/lib/Lintian/CheckScript.pm
index a2028ce..d214562 100644
--- a/lib/Lintian/CheckScript.pm
+++ b/lib/Lintian/CheckScript.pm
@@ -28,7 +28,7 @@ use parent 'Class::Accessor';
use Carp qw(croak);
use Lintian::Tag::Info ();
-use Lintian::Util qw(read_dpkg_control);
+use Lintian::Util qw(read_dpkg_control untaint);
=head1 NAME
@@ -82,7 +82,9 @@ sub new {
or croak "Cannot resolve $basedir: $!";
$self = {
- 'name' => $header->{'check-script'},
+ # checks are loaded from trusted dirs, untaint name (used in
+ # eval for finding the package name)
+ 'name' => untaint($header->{'check-script'}),
'type' => $header->{'type'}, # lintian.desc has no type
'abbrev' => $header->{'abbrev'},
'needs_info' => [split /\s*,\s*/, $header->{'needs-info'}//''],
@@ -92,7 +94,8 @@ sub new {
$self->{'script_pkg'} =~ s,/,::,go;
$self->{'script_pkg'} =~ s,[-.],_,go;
- $self->{'script_path'} = $dir . '/' . $self->{'name'};
+ # untaint the path name as well (used in require)
+ $self->{'script_path'} = untaint($dir . '/' . $self->{'name'});
$self->{'script_run'} = undef; # init'ed with $self->load_check later
diff --git a/lib/Lintian/CollScript.pm b/lib/Lintian/CollScript.pm
index c38bc3d..4722f78 100644
--- a/lib/Lintian/CollScript.pm
+++ b/lib/Lintian/CollScript.pm
@@ -26,7 +26,7 @@ use parent 'Class::Accessor';
use Carp qw(croak);
use File::Basename qw(dirname);
-use Lintian::Util qw(fail get_dsc_info);
+use Lintian::Util qw(fail get_dsc_info untaint);
=head1 NAME
@@ -69,7 +69,10 @@ sub new {
}
$self = {
- 'name' => $header->{'collector-script'},
+ # collections are loaded from trusted dirs, untaint name (used
+ # in eval for finding the package name with perl-coll
+ # interface)
+ 'name' => untaint($header->{'collector-script'}),
'type' => $header->{'type'},
'version' => $header->{'version'},
'type-table' => {},
@@ -77,7 +80,8 @@ sub new {
'interface' => $header->{'interface'}//'exec',
'_collect_sub' => undef,
};
- $self->{'script_path'} = dirname ($file) . '/' . $self->{'name'};
+ # untaint script path (used in require)
+ $self->{'script_path'} = untaint(dirname($file) . '/' . $self->{'name'});
$self->{'auto_remove'} = 1
if lc ($header->{'auto-remove'}//'') eq 'yes';
for my $t (split /\s*,\s*/o, $self->{'type'}) {
diff --git a/lib/Lintian/Lab.pm b/lib/Lintian/Lab.pm
index 99ee656..f2af9b2 100644
--- a/lib/Lintian/Lab.pm
+++ b/lib/Lintian/Lab.pm
@@ -58,7 +58,7 @@ my %SUPPORTED_VIEWS = (
use Lintian::Collect;
use Lintian::Lab::Entry;
use Lintian::Lab::Manifest;
-use Lintian::Util qw(delete_dir get_dsc_info);
+use Lintian::Util qw(delete_dir get_dsc_info untaint);
=encoding utf8
@@ -674,6 +674,7 @@ sub create {
my $t = tempdir ('temp-lintian-lab-XXXXXXXXXX', %topts);
$dir = Cwd::abs_path ($t);
croak "Could not resolve $t: $!" unless $dir;
+ $dir = untaint($dir);
$self->{'dir'} = $dir;
$self->{'keep-lab'} = $keep;
} else {
diff --git a/lib/Lintian/Processable/Package.pm b/lib/Lintian/Processable/Package.pm
index 9276ce4..159b354 100644
--- a/lib/Lintian/Processable/Package.pm
+++ b/lib/Lintian/Processable/Package.pm
@@ -27,7 +27,7 @@ use warnings;
use Cwd qw(realpath);
use Carp qw(croak);
-use Lintian::Util qw(get_deb_info get_dsc_info);
+use Lintian::Util qw(get_deb_info get_dsc_info untaint);
# Black listed characters - any match will be replaced with a _.
use constant EVIL_CHARACTERS => qr,[/&|;\$"'<>],o;
@@ -95,6 +95,9 @@ sub new {
croak "Cannot resolve $file: $!"
unless $pkg_path;
+ # FIXME: this might a bit too liberal.
+ $pkg_path = untaint($pkg_path);
+
$self = {
pkg_type => $pkg_type,
pkg_path => $pkg_path,
diff --git a/lib/Lintian/Util.pm b/lib/Lintian/Util.pm
index d83a6f4..2b1e037 100644
--- a/lib/Lintian/Util.pm
+++ b/lib/Lintian/Util.pm
@@ -76,6 +76,7 @@ BEGIN {
normalize_pkg_path
parse_boolean
is_ancestor_of
+ untaint
$PKGNAME_REGEX),
@{ $EXPORT_TAGS{constants} }
);
@@ -1268,6 +1269,20 @@ sub is_ancestor_of {
return 0;
}
+=item untaint(VALUE)
+
+Return a copy of VALUE which is not "tainted".
+
+=cut
+
+sub untaint {
+ my ($val) = @_;
+ if ($val =~ m{\A ( .*+ ) \Z}xsm) {
+ return $1;
+ }
+ die qq{"$val" does not match the "match anything" pattern!?\n};
+}
+
=back
=head1 SEE ALSO
Reply to: