Fix some vulnerabilities related to what is shared to the safe compartment.

conf/pg_config.dist.yml

@@ -189,7 +189,6 @@ modules:
   - ['Encode::Encoding']
   - ['HTML::Parser']
   - ['HTML::Entities']
-  - [DynaLoader]
   - [Exporter]
   - [GD]
   - [utf8]
@@ -233,7 +232,6 @@ modules:
   - ['Locale::Maketext']
   - ['WeBWorK::PG::Localize']
   - ['Mojo::JSON']
-  - ['IO::Handle']
   - ['Rserve']
   - [DragNDrop]
   - ['Types::Serialiser']

lib/Rserve.pm

@@ -49,6 +49,17 @@ sub new {
 
 	$self->{_autoflush} //= 1;
 
+	# When no filehandle was already supplied (i.e. a new connection is about to be opened), the host to connect to is
+	# always taken from the trusted PG environment configuration, never from whatever server/port a caller passed to
+	# this constructor. A problem source file or macro file cannot override this, since $WeBWorK::PG::IO::pg_envir is
+	# not visible to safe compartment code.
+	if (!defined $self->{fh} && defined $WeBWorK::PG::IO::pg_envir) {
+		my $host = $WeBWorK::PG::IO::pg_envir->{specialPGEnvironmentVars}{Rserve}{host};
+		croak 'Rserve is not configured' unless $host;
+		$self->{server} = $host;
+		$self->{port}   = $WeBWorK::PG::IO::pg_envir->{specialPGEnvironmentVars}{Rserve}{port} // 6311;
+	}
+
 	$self->{server} //= 'localhost';
 	die q{Attribute 'server' must be scalar value}
 		if exists($self->{server}) && (!defined $self->server || ref($self->server));

lib/WWSafe.pm

@@ -265,6 +265,33 @@ sub share_from {
 	$obj->share_record($pkg, $vars) unless $no_record or !$vars;
 }
 
+# Creates an empty package stash named $name directly under the compartment's root. This is not connected to any real
+# package. This is for packages that must exist so Perl's method resolution can walk through them (e.g. a shared
+# module's @ISA lists a package that must be resolvable, even though none of its actual methods should be reachable from
+# the compartment) without sharing that package's real contents.
+sub share_empty_package {
+	my ($obj, $name) = @_;
+	my $root = $obj->root();
+	no strict 'refs';
+	*{"${root}::${name}::"} = {};
+	return;
+}
+
+# Aliases $name, as seen from inside the compartment, to a real package's symbol table, rather than to whatever real
+# package happens to be named $name outside the compartment. Unlike share_from, which shares specific symbols but leaves
+# bless and method resolution for a class needing a fresh bless from code running nested inside a live reval
+# unresolvable unless that exact class name is itself an alias to a real package's symbol table, this lets $source_pkg
+# (e.g. a small, narrow package built on purpose) stand in for $name so that such a bless resolves correctly, without
+# exposing $name's real, unrestricted contents.
+sub share_package_as {
+	my ($obj, $name, $source_pkg) = @_;
+	my $root = $obj->root();
+	no strict 'refs';
+	croak("Package \"$source_pkg\" does not exist") unless keys %{"$source_pkg\::"};
+	*{"${root}::${name}::"} = \%{"${source_pkg}::"};
+	return;
+}
+
 sub share_record {
 	my $obj    = shift;
 	my $pkg    = shift;

lib/WeBWorK/PG/SafeIOHandle.pm

@@ -0,0 +1,32 @@
+package WeBWorK::PG::SafeIOHandle;
+
+=head1 NAME
+
+WeBWorK::PG::SafeIOHandle - A restricted stand-in for IO::Handle, shared into
+the safe compartment.
+
+=head1 DESCRIPTION
+
+L<Rserve> blesses its connection socket as an L<IO::Handle> and uses its
+C<print>, C<flush>, C<read>, and C<close> methods. If the C<IO::Handle> package
+is shared directly, then all of its methods are exposed. In particular the
+C<new_from_fd> method is exposed (in addition to other potentially dangerous
+methods such as C<new>, C<fdopen>, etc.) which allows a PG problem to wrap and
+read from or write to any file descriptor the process happens to have open. So
+instead this package is shared aliased as the C<IO::Handle> package (via
+C<WWSafe::share_package_as>) exposing only the necessary methods.
+
+=cut
+
+use strict;
+use warnings;
+
+use IO::Handle;
+
+BEGIN {
+	no strict 'refs';
+	*{"WeBWorK::PG::SafeIOHandle::$_"} = \&{"IO::Handle::$_"} for qw(print flush read close);
+	use strict 'refs';
+}
+
+1;

lib/WeBWorK/PG/Translator.pm

@@ -56,6 +56,7 @@ use Mojo::DOM;
 use WWSafe;
 use PGUtil          qw(pretty_print);
 use WeBWorK::PG::IO qw(fileFromPath);
+use WeBWorK::PG::SafeIOHandle;
 
 BEGIN {
 	# Setup the safe compartment for the standalone renderer.
@@ -91,6 +92,12 @@ BEGIN {
 
 		$safeCache->share_from('main', $ra_included_modules);
 
+		# GD's @ISA includes DynaLoader (a common pattern for older XS modules), and so Perl's method resolution needs a
+		# "DynaLoader" package to be resolvable for anything that inherits from GD (e.g. WWPlot).  Share an empty stash
+		# rather than the real DynaLoader package, which would let any PG problem bootstrap and call into the raw XS
+		# functions of any installed shared library directly.
+		$safeCache->share_empty_package('DynaLoader');
+
 		my $store_mask = $safeCache->mask();
 		$safeCache->mask(Opcode::empty_opset());
 		my $safe_cmpt_package_name = $safeCache->root();
@@ -233,6 +240,9 @@ The following translator methods are shared to the safe compartment:
 
 Also all methods that are exported by WeBWorK::PG::IO are shared.
 
+The compartment's view of IO::Handle is aliased to WeBWorK::PG::SafeIOHandle
+which is a restricted stand-in.
+
 In addition the environment hash C<%envir> is shared.  This variable is unpacked
 when PG.pl is run.
 
@@ -255,6 +265,13 @@ sub initialize {
 	$safe_cmpt->share_from('WeBWorK::PG::Translator', \@Translator_shared_subroutine_array);
 	$safe_cmpt->share_from('WeBWorK::PG::IO',         \@WeBWorK::PG::IO::EXPORT_OK);
 
+	# The Rserve package blesses its connection socket as an IO::Handle. So the WeBWorK::PG::SafeIOHandle package which
+	# aliases only print/flush/read/close from the IO::Handle package is shared as an alias to the IO::Handle package
+	# rather than sharing the IO::Handle package itself. Sharing the entire IO::Handle package would expose
+	# IO::Handle->new_from_fd(FD, MODE), and that would let a PG problem wrap and read or write to any file descriptor
+	# number the process happens to have open.
+	$safe_cmpt->share_package_as('IO::Handle', 'WeBWorK::PG::SafeIOHandle');
+
 	no strict;
 	local (%envir) = %{ $self->{envir} };
 	$safe_cmpt->share('%envir');
@@ -265,6 +282,7 @@ sub initialize {
 	# The standalone renderer does this when the module is compiled.
 	unless (exists($ENV{MOJO_MODE})) {
 		$safe_cmpt->share_from('main', $self->{ra_included_modules});
+		$safe_cmpt->share_empty_package('DynaLoader');
 	}
 
 	return;
@@ -497,7 +515,7 @@ sub set_mask {
 	# Just to make sure, deny some things specifically.
 	$safe_cmpt->deny(qw(entereval));
 	$safe_cmpt->deny(qw(unlink symlink system exec));
-	$safe_cmpt->deny(qw(print require));
+	$safe_cmpt->deny(qw(print prtf require));
 	return;
 }
 

macros/core/RserveClient.pl

@@ -181,7 +181,7 @@ =head2 rserve_data_url
 
 sub _RserveClient_init { }
 
-my $rserve;    # Statistics::R::IO::Rserve instance
+my $rserve;    # Rserve instance
 
 sub _rserve_warn_no_config {
 	my @trace      = split /\n/, Value::traceback();

t/rserve/rserve-eval-live.t

@@ -22,6 +22,10 @@ use TestCases qw(TEST_CASES);
 # Fake configuration if this is disabled (it is by default in pg_config.dist.yml).
 $main::Rserve = { host => 'localhost' } unless ref($main::Rserve) eq 'HASH' && $main::Rserve->{host};
 
+# The actual host used to connect is read from $WeBWorK::PG::IO::pg_envir
+# (a trusted server configuration), not from $main::Rserve.
+$WeBWorK::PG::IO::pg_envir->{specialPGEnvironmentVars}{Rserve} = $main::Rserve;
+
 my $s;
 eval {
 	socket($s, PF_INET, SOCK_STREAM, getprotobyname('tcp'))          or die "socket: $!";

t/rserve/rserve-getfile-live.t

@@ -17,6 +17,10 @@ use Rserve;
 # Fake configuration if this is disabled (it is by default in pg_config.dist.yml).
 $main::Rserve = { host => 'localhost' } unless ref($main::Rserve) eq 'HASH' && $main::Rserve->{host};
 
+# The actual host used to connect is read from $WeBWorK::PG::IO::pg_envir
+# (a trusted server configuration), not from $main::Rserve.
+$WeBWorK::PG::IO::pg_envir->{specialPGEnvironmentVars}{Rserve} = $main::Rserve;
+
 my $s;
 eval {
 	socket($s, PF_INET, SOCK_STREAM, getprotobyname('tcp'))          or die "socket: $!";

t/rserve/rserveclient-macro.t

@@ -25,6 +25,10 @@ use TestCases qw(TEST_CASES);
 # Fake configuration if this is disabled (it is by default in pg_config.dist.yml).
 $main::Rserve = { host => 'localhost' } unless ref($main::Rserve) eq 'HASH' && $main::Rserve->{host};
 
+# The actual host used to connect is read from $WeBWorK::PG::IO::pg_envir (a trusted server configuration), not from
+# $main::Rserve, which is only consulted by RserveClient.pl for its "is this configured" message.
+$WeBWorK::PG::IO::pg_envir->{specialPGEnvironmentVars}{Rserve} = $main::Rserve;
+
 my $s;
 eval {
 	socket($s, PF_INET, SOCK_STREAM, getprotobyname('tcp'))          || die "socket: $!";