From d136fce9bba7730b031bff59c609830f3e072866 Mon Sep 17 00:00:00 2001
From: Thomas Liske <thomas@fiasko-nw.net>
Date: Mon, 4 Nov 2024 22:29:51 +0100
Subject: [PATCH 5/5] interp: drop usage of Module::ScanDeps to prevent LPE

---
 INSTALL.md                          |  1 -
 README.Interp.md                    |  9 +++-
 perl/Makefile.PL                    |  1 -
 perl/lib/NeedRestart/Interp/Perl.pm | 70 ++++++++++++++++++++---------
 4 files changed, 57 insertions(+), 24 deletions(-)

--- a/INSTALL.md
+++ b/INSTALL.md
@@ -5,7 +5,6 @@ Perl
 ----
 
 - Module::Find
-- Module::ScanDeps
 - Locale::TextDomain
 - Proc::ProcessTable
 - Sort::Naturally
--- a/README.Interp.md
+++ b/README.Interp.md
@@ -35,8 +35,13 @@ NeedRestart::Interp::Perl
 Recognized binaries:	/usr/(local/)?bin/perl
 Find source file by:	command line interpretation
 
-We are using `Module::ScanDeps` to find used packages. This should work on
-any static loaded packages, dynamic stuff will fail.
+The source file is scanned only for 'use' lines, other module loading
+mechanisms will not be recognized.
+
+*This function used the Module::ScanDeps package to get the used Perl packages
+until needrestart 3.7. Module::ScanDeps is not used any more as it seems not
+to be designed to work with untrustworthy perl sources which would allow an
+attacker to use needrestart for local privilege escalation.*
 
 
 NeedRestart::Interp::Python
--- a/perl/Makefile.PL
+++ b/perl/Makefile.PL
@@ -6,7 +6,6 @@ WriteMakefile(
     'NAME'		=> 'NeedRestart',
     'PREREQ_PM'		=> {
 	Module::Find => 0,
-	Module::ScanDeps => 0,
 	Proc::ProcessTable => 0,
 	Sort::Naturally => 0,
 	Term::ReadKey => 0.
--- a/perl/lib/NeedRestart/Interp/Perl.pm
+++ b/perl/lib/NeedRestart/Interp/Perl.pm
@@ -32,7 +32,6 @@ use Cwd qw(abs_path getcwd);
 use Getopt::Std;
 use NeedRestart qw(:interp);
 use NeedRestart::Utils;
-use Module::ScanDeps;
 
 my $LOGPREF = '[Perl]';
 
@@ -48,6 +47,41 @@ sub isa {
     return 0;
 }
 
+sub _scan($$$$$) {
+    my $debug = shift;
+    my $pid = shift;
+    my $src = shift;
+    my $files = shift;
+    my $path = shift;
+
+    my $fh;
+    open($fh, '<', $src) || return;
+    # find used modules
+    my %modules = map {
+	(/^\s*use\s+([a-zA-Z][\w:]+)/ ? ($1 => 1) : ())
+    } <$fh>;
+    close($fh);
+
+    # track file
+    $files->{$src}++;
+
+    # scan module files
+    if(scalar keys %modules) {
+	foreach my $module (keys %modules) {
+        # skip some well-known Perl pragmas
+        next if ($module =~ /^(constant|strict|vars|v5(\.\d+)?|warnings)$/);
+
+	    $module =~ s@::@/@g;
+	    $module .= '.pm';
+
+	    foreach my $p (@$path) {
+		my $fn = ($p ne '' ? "$p/" : '').$module;
+		&_scan($debug, $pid, $fn, $files, $path) if(!exists($files->{$fn}) && -r $fn && -f $fn);
+	    }
+	}
+    }
+}
+
 sub source {
     my $self = shift;
     my $pid = shift;
@@ -160,31 +194,28 @@ sub files {
     }
 
     # prepare include path environment variable
-    my %e = nr_parse_env($pid);
+    my @path;
     local %ENV;
+
+    # get include path from env
+    my %e = nr_parse_env($pid);
     if(exists($e{PERL5LIB})) {
-	$ENV{PERL5LIB} = $e{PERL5LIB};
-    }
-    elsif(exists($ENV{PERL5LIB})) {
-	delete($ENV{PERL5LIB});
+	@path = map { "/proc/$pid/root/$_"; } split(':', $e{PERL5LIB});
     }
 
-    @Module::ScanDeps::IncludeLibs = (exists($opts{I}) ? ($opts{I}) : ());
-    my $href;
-    {
-	# Silence warnings of Module::ScanDeps for dynamic loaded modules (github issue #41)
-	local $SIG{__WARN__} = sub { };
+    # get include path from @INC
+    my $plread = nr_fork_pipe($self->{debug}, $ptable->{exec}, '-e', 'print(join("\n", @INC));');
+    push(@path, map { "/proc/$pid/root/$_"; } <$plread>);
+    close($plread);
+    chomp(@path);
 
-	$href = scan_deps(
-	    files => [$src],
-	    recurse => 1,
-	    );
-    }
+    my %files;
+    _scan($self->{debug}, $pid, $src, \%files, \@path);
 
     my %ret = map {
-	my $stat = nr_stat("/proc/$pid/root/$href->{$_}->{file}");
-	$href->{$_}->{file} => ( defined($stat) ? $stat->{ctime} : undef );
-    } keys %$href;
+	my $stat = nr_stat("/proc/$pid/root/$_");
+	$_ => ( defined($stat) ? $stat->{ctime} : undef );
+    } keys %files;
 
     chdir($cwd);