From 3d4446bcd520a003c19a303b0f260c674c94b98c Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Fri, 28 Aug 2026 17:25:07 +0200 Subject: [PATCH 1/4] fix: taint Cwd results under -T Mark the operating-system paths returned by Internals::getcwd and Internals::abs_path as tainted while taint mode is active, so every Cwd entry point Cwd.pm aliases to them (getcwd, cwd, fastcwd, fastgetcwd, abs_path, realpath, fast_abs_path, fast_realpath) matches standard Perl. Data::Compare's "unless tainted getcwd()" guard now disables plugin discovery instead of walking plugin directories with File::Find. Fixes #1125 Co-Authored-By: Claude Opus 5 (1M context) --- docs/about/changelog.md | 3 ++ .../runtime/perlmodule/Internals.java | 24 +++++++-- src/test/resources/unit/taint_cwd.t | 49 +++++++++++++++++++ 3 files changed, 73 insertions(+), 3 deletions(-) create mode 100644 src/test/resources/unit/taint_cwd.t diff --git a/docs/about/changelog.md b/docs/about/changelog.md index aacd74ded..62e95909b 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -33,6 +33,9 @@ Release history of PerlOnJava. See [Roadmap](roadmap.md) for future plans. stage generated nested pure-Perl MakeMaker modules correctly (including NetAddr::IP's `-noxs` installation path). - Preserve `CORE::__SUB__` from enclosing named subroutines inside sort blocks. +- Taint `Cwd` results under `-T` (`getcwd`, `cwd`, `fastcwd`, `fastgetcwd`, + `abs_path`, `realpath`, `fast_abs_path`, `fast_realpath`), matching standard + Perl and restoring Data::Compare's taint-mode plugin guard. - Preserve the lifetime of borrowed `+>&=` filehandle aliases, restoring `Tie::File::Indexed` file-backed array storage. - Add a pure-Perl `JSON::Parse` compatibility layer backed by bundled `JSON::PP`. diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java b/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java index ee0625a5b..bf70557db 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java @@ -900,12 +900,19 @@ public static RuntimeList isInitializedStateVariable(RuntimeArray args, int ctx) * This provides a native Java implementation that works on all platforms, * which Cwd.pm will use instead of shell-based fallbacks. * + *

The path comes from the operating system, so it is tainted under + * {@code -T} exactly like {@code Cwd::getcwd} in standard Perl. Cwd.pm + * aliases getcwd/cwd/fastcwd/fastgetcwd to this method, so tainting here + * covers every current-directory entry point. + * * @param args Unused arguments * @param ctx The context in which the method is called * @return RuntimeScalar with the current working directory path */ public static RuntimeList getcwd(RuntimeArray args, int ctx) { - return new RuntimeScalar(RuntimeEnvironment.currentDirectory()).getList(); + return new RuntimeScalar(RuntimeEnvironment.currentDirectory()) + .taintFromExternalInput() + .getList(); } /** @@ -913,6 +920,11 @@ public static RuntimeList getcwd(RuntimeArray args, int ctx) { * This provides a reliable, platform-independent way to get absolute paths, * which Cwd.pm will use instead of Perl-based implementations. * + *

Like the XS {@code Cwd::abs_path}, the resolved path is derived from + * the file system, so it is tainted under {@code -T} regardless of whether + * the argument was tainted. Cwd.pm aliases + * abs_path/realpath/fast_abs_path/fast_realpath to this method. + * * @param args The path to resolve (first argument), or "." if not provided * @param ctx The context in which the method is called * @return RuntimeScalar with the absolute path, or undef if the path doesn't exist @@ -925,7 +937,11 @@ public static RuntimeList abs_path(RuntimeArray args, int ctx) { // produced bare "-I" flags and broke Inline's config subprocess. if (path.startsWith("jar:")) { if (Jar.isJarDirectory(path) || Jar.exists(path)) { - return new RuntimeScalar(path).getList(); + // The embedded library path is echoed back unchanged; it carries + // no operating-system data of its own, so only the caller's taint + // is propagated. Inline uses these paths to build -I flags. + RuntimeScalar jarPath = new RuntimeScalar(path); + return (args.size() > 0 ? jarPath.propagateTaint(args.get(0)) : jarPath).getList(); } return new RuntimeScalar().getList(); } @@ -937,7 +953,9 @@ public static RuntimeList abs_path(RuntimeArray args, int ctx) { if (!file.exists()) { return new RuntimeScalar().getList(); // return undef } - return new RuntimeScalar(file.getCanonicalPath()).getList(); + return new RuntimeScalar(file.getCanonicalPath()) + .taintFromExternalInput() + .getList(); } catch (java.io.IOException e) { return new RuntimeScalar().getList(); // return undef on error } diff --git a/src/test/resources/unit/taint_cwd.t b/src/test/resources/unit/taint_cwd.t new file mode 100644 index 000000000..7147d70fe --- /dev/null +++ b/src/test/resources/unit/taint_cwd.t @@ -0,0 +1,49 @@ +#!perl -T +use strict; +use warnings; +use Cwd (); +use Scalar::Util qw(tainted); +use Test::More; + +# The current working directory is operating-system data, so standard Perl +# taints every Cwd entry point under -T. Verified against system perl before +# being used to drive the PerlOnJava fix (GitHub issue #1125). +for my $name (qw(getcwd cwd fastcwd fastgetcwd)) { + my $code = Cwd->can($name); + ok($code, "Cwd::$name is available"); + my $value = $code->(); + ok(defined $value && length $value, "Cwd::$name returns a path"); + ok(tainted($value), "Cwd::$name is tainted under -T"); +} + +for my $name (qw(abs_path realpath fast_abs_path fast_realpath)) { + my $code = Cwd->can($name); + ok($code, "Cwd::$name is available"); + my $value = $code->('.'); + ok(defined $value && length $value, "Cwd::$name('.') returns a path"); + ok(tainted($value), "Cwd::$name('.') is tainted under -T"); +} + +# A clean literal argument does not produce a clean result: abs_path resolves +# the path against the file system, so the answer is OS-derived either way. +ok(tainted(Cwd::abs_path('/')), "abs_path('/') is tainted for a clean argument"); + +# Data::Compare guards plugin discovery with +# "register_plugins() unless tainted(getcwd()) || !chdir $cwd", so copies and +# derived strings must keep the taint too. +my $copy = Cwd::getcwd(); +ok(tainted($copy), 'a copy of getcwd() stays tainted'); +ok(tainted("$copy/sub"), 'interpolating getcwd() propagates taint'); + +# The tainted directory cannot reach chdir without being laundered first. +my $chdir_ok = eval { chdir Cwd::getcwd(); 1 }; +ok(!$chdir_ok, 'chdir rejects the tainted getcwd() value'); +like($@, qr/^Insecure dependency in chdir while running with -T switch/, + 'chdir reports the Perl security error for a tainted directory'); + +# Laundering through a regexp match restores a usable value. +my ($laundered) = Cwd::getcwd() =~ /\A(.*)\z/s; +ok(!tainted($laundered), 'a laundered copy of getcwd() is clean'); +ok(chdir($laundered), 'the laundered directory can be used with chdir'); + +done_testing; From 4fceafe245305daab25ba1b290793ee004f65422 Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Fri, 28 Aug 2026 17:51:58 +0200 Subject: [PATCH 2/4] fix: distinguish logical and physical cwd in Cwd Cwd.pm aliased all four current-directory functions to the single Internals::getcwd builtin, which reports the physical (symlink-resolved) path. Standard Perl splits them on Unix-like platforms: cwd() and fastgetcwd() run `pwd`, which is logical, while getcwd() and fastcwd() ask the operating system. With the shell in /tmp on darwin, real perl returns /tmp from cwd()/fastgetcwd() and /private/tmp from getcwd()/fastcwd(); PerlOnJava returned /private/tmp from all four. Add Internals::logical_cwd, which returns $ENV{PWD} only when it can be trusted and the physical path otherwise. $ENV{PWD} is accepted only when it is a defined, non-empty, absolute path that names the very same directory as the current one, decided by Files.isSameFile (a device+inode comparison on Unix, the same test pwd performs). A stale value left behind by a plain chdir, a relative or nonexistent path, or a hostile value all fall back to the physical path, so cwd() cannot be made to lie. A different symlinked alias of the current directory is accepted, matching pwd. Cwd.pm now aliases getcwd/fastcwd to Internals::getcwd and cwd/fastgetcwd to Internals::logical_cwd, following standard Perl's %METHOD_MAP for the platforms where the split does not exist: MSWin32/NT/dos/os2/VMS/qnx alias all four to one platform function, and cygwin/amigaos route all four through `pwd`. Both builtins stay tainted under -T. Callers that need a canonical path already use getcwd or abs_path (File::Find, File::Spec::Unix::rel2abs, FindBin), so none needed changing; the cwd() callers in CPAN, Archive::Tar, ExtUtils::Install and Pod::Simple::Search only save-and-restore or join paths, exactly as they do under standard Perl. Add unit/cwd_logical_physical.t, which builds its own symlinked temp directory so it does not depend on the runner's cwd, skips where symlinks are unavailable, and covers the valid, stale, nonexistent, relative, empty, absent, and aliased $ENV{PWD} cases. Validated against system perl v5.42 on darwin; three assertions fail with the pre-fix Cwd.pm. Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude Opus 5 (1M context) --- docs/about/changelog.md | 3 + .../runtime/perlmodule/Internals.java | 83 +++++++++++++++- src/main/perl/lib/Cwd.pm | 47 +++++++-- .../resources/unit/cwd_logical_physical.t | 95 +++++++++++++++++++ 4 files changed, 217 insertions(+), 11 deletions(-) create mode 100644 src/test/resources/unit/cwd_logical_physical.t diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 62e95909b..59daff794 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -36,6 +36,9 @@ Release history of PerlOnJava. See [Roadmap](roadmap.md) for future plans. - Taint `Cwd` results under `-T` (`getcwd`, `cwd`, `fastcwd`, `fastgetcwd`, `abs_path`, `realpath`, `fast_abs_path`, `fast_realpath`), matching standard Perl and restoring Data::Compare's taint-mode plugin guard. +- Distinguish the logical from the physical current directory in `Cwd`: + `cwd` and `fastgetcwd` now report a validated `$ENV{PWD}` while `getcwd` and + `fastcwd` stay physical, matching standard Perl on Unix-like platforms. - Preserve the lifetime of borrowed `+>&=` filehandle aliases, restoring `Tie::File::Indexed` file-backed array storage. - Add a pure-Perl `JSON::Parse` compatibility layer backed by bundled `JSON::PP`. diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java b/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java index bf70557db..d84c86e3f 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java @@ -62,6 +62,7 @@ public static void initialize() { internals.registerMethod("stack_refcounted", null); internals.registerMethod("V", "V", null); internals.registerMethod("getcwd", "getcwd", null); + internals.registerMethod("logical_cwd", "logical_cwd", null); internals.registerMethod("abs_path", "abs_path", ";$"); // PerlOnJava-only probe: report whether a fully qualified sub // name was installed via typeglob assignment (e.g. Exporter @@ -900,10 +901,14 @@ public static RuntimeList isInitializedStateVariable(RuntimeArray args, int ctx) * This provides a native Java implementation that works on all platforms, * which Cwd.pm will use instead of shell-based fallbacks. * + *

This is the physical current directory: {@code chdir} + * canonicalizes the target, so symlinks such as macOS {@code /tmp -> + * /private/tmp} are already resolved. Cwd.pm aliases {@code getcwd} and + * {@code fastcwd} to this method; the logical forms {@code cwd} and + * {@code fastgetcwd} use {@link #logical_cwd} instead. + * *

The path comes from the operating system, so it is tainted under - * {@code -T} exactly like {@code Cwd::getcwd} in standard Perl. Cwd.pm - * aliases getcwd/cwd/fastcwd/fastgetcwd to this method, so tainting here - * covers every current-directory entry point. + * {@code -T} exactly like {@code Cwd::getcwd} in standard Perl. * * @param args Unused arguments * @param ctx The context in which the method is called @@ -915,6 +920,78 @@ public static RuntimeList getcwd(RuntimeArray args, int ctx) { .getList(); } + /** + * Returns the logical current working directory, the value that + * {@code Cwd::cwd} and {@code Cwd::fastgetcwd} return in standard Perl. + * + *

On Unix-like systems those two functions shell out to {@code /bin/pwd}, + * which runs in its default logical mode: it reports {@code $ENV{PWD}} when + * that variable can be trusted and otherwise falls back to the + * {@code getcwd(3)} answer. So after {@code cd /tmp} on macOS, + * {@code cwd()} yields {@code /tmp} while {@code getcwd()} yields + * {@code /private/tmp}. + * + *

{@code $ENV{PWD}} is never trusted blindly — a stale value left behind + * by a plain {@code chdir}, or a hostile one, must not make {@code cwd()} + * lie. It is accepted only when it is an absolute path that names the very + * same directory as {@code .}, which is decided by + * {@link java.nio.file.Files#isSameFile} (a device+inode comparison on + * Unix, the same test {@code pwd} performs). Anything else — unset, empty, + * relative, nonexistent, or a different directory — falls back to the + * physical path. + * + *

Like {@link #getcwd}, the result describes the operating system's idea + * of the current directory and is therefore tainted under {@code -T}. + * + * @param args Unused arguments + * @param ctx The context in which the method is called + * @return RuntimeScalar with the logical current working directory path + */ + public static RuntimeList logical_cwd(RuntimeArray args, int ctx) { + String physical = RuntimeEnvironment.currentDirectory(); + String logical = trustedEnvPwd(physical); + return new RuntimeScalar(logical != null ? logical : physical) + .taintFromExternalInput() + .getList(); + } + + /** + * Returns {@code $ENV{PWD}} when it can stand in for the physical current + * directory, or {@code null} when it cannot be trusted. + * + * @param physical the physical current directory + * @return the trusted logical path, or {@code null} + */ + private static String trustedEnvPwd(String physical) { + RuntimeScalar pwd = GlobalVariable.getGlobalHash("main::ENV").get("PWD"); + if (pwd == null || !pwd.getDefinedBoolean()) { + return null; + } + String candidate = pwd.toString(); + // An empty or relative PWD is meaningless as an absolute answer, and a + // path with a NUL byte cannot reach the file system at all. + if (candidate.isEmpty() || candidate.indexOf('\0') >= 0) { + return null; + } + try { + java.nio.file.Path candidatePath = java.nio.file.Paths.get(candidate); + if (!candidatePath.isAbsolute()) { + return null; + } + // Same directory? On Unix this compares device and inode numbers, + // so any symlinked alias of the current directory is accepted and + // any stale or hostile value is rejected. + if (java.nio.file.Files.isSameFile(candidatePath, java.nio.file.Paths.get(physical))) { + return candidate; + } + } catch (java.io.IOException | RuntimeException e) { + // Nonexistent path, unreadable parent, or an unparseable name: + // treat PWD as untrustworthy and use the physical path. + return null; + } + return null; + } + /** * Gets the absolute path of a file or directory, resolving . and .. components. * This provides a reliable, platform-independent way to get absolute paths, diff --git a/src/main/perl/lib/Cwd.pm b/src/main/perl/lib/Cwd.pm index adec24cae..9367bd467 100644 --- a/src/main/perl/lib/Cwd.pm +++ b/src/main/perl/lib/Cwd.pm @@ -76,18 +76,49 @@ sub _vms_efs { } -# PerlOnJava provides Internals::getcwd/abs_path which work on all platforms. -# Check early to prevent XSLoader from being loaded (which would fail). These -# aliases intentionally replace the pure-Perl definitions compiled below, so -# keep them quiet even when a caller has dynamically enabled global warnings. +# PerlOnJava provides Internals::getcwd/logical_cwd/abs_path, which work on all +# platforms. Check early to prevent XSLoader from being loaded (which would +# fail). These aliases intentionally replace the pure-Perl definitions compiled +# below, so keep them quiet even when a caller has dynamically enabled global +# warnings. +# +# Internals::getcwd is the PHYSICAL path (symlinks resolved), matching the +# getcwd(3) syscall used by the XS Cwd::getcwd. +# Internals::logical_cwd is the LOGICAL path: a validated $ENV{PWD} if it names +# the current directory, otherwise the physical path. +# This is what `pwd` reports, which is how standard Perl +# implements cwd() on Unix (see _backtick_pwd below). +# +# Which name gets which form is platform-dependent in standard Perl, so follow +# its %METHOD_MAP table below: +# * Unix-like (darwin, linux, *bsd, solaris, ...): cwd() and fastgetcwd() are +# _backtick_pwd (logical); getcwd() is XS and fastcwd() walks up with +# chdir('..') -- both physical. +# * MSWin32/NT/dos/os2/VMS/qnx: all four names are aliases for one +# platform-specific function, so there is no logical/physical split. +# * cygwin/amigaos: all four names resolve to _backtick_pwd, i.e. all logical. { no warnings qw(redefine prototype); local $^W = 0; if (eval { Internals::getcwd(); 1 }) { - *getcwd = \&Internals::getcwd; - *cwd = sub { Internals::getcwd() }; - *fastcwd = \&cwd; - *fastgetcwd = \&cwd; + my $physical = \&Internals::getcwd; + my $logical = defined &Internals::logical_cwd + ? \&Internals::logical_cwd + : $physical; + + if ($^O =~ /\A(?:MSWin32|NT|dos|os2|VMS|qnx)\z/) { + # No logical form on these platforms. + $logical = $physical; + } + elsif ($^O eq 'cygwin' or $^O eq 'amigaos') { + # Everything goes through `pwd` on these platforms. + $physical = $logical; + } + + *getcwd = $physical; + *fastcwd = $physical; + *cwd = $logical; + *fastgetcwd = $logical; } if (eval { Internals::abs_path('.'); 1 }) { *abs_path = \&Internals::abs_path; diff --git a/src/test/resources/unit/cwd_logical_physical.t b/src/test/resources/unit/cwd_logical_physical.t new file mode 100644 index 000000000..6de983327 --- /dev/null +++ b/src/test/resources/unit/cwd_logical_physical.t @@ -0,0 +1,95 @@ +use strict; +use warnings; +use Test::More; +use Cwd (); +use File::Temp qw(tempdir); + +# Standard Perl's Cwd distinguishes the LOGICAL current directory from the +# PHYSICAL one on Unix-like systems: +# +# cwd() logical - `pwd`, which reports a trusted $ENV{PWD} +# fastgetcwd() logical - a synonym for cwd() +# getcwd() physical - getcwd(3), symlinks resolved +# fastcwd() physical - walks up with chdir('..') +# +# PerlOnJava used to alias all four to one physical builtin. Verified against +# system perl v5.42 on darwin before being used to drive the fix. +# +# On the platforms where standard Perl aliases all four names to a single +# platform function there is nothing to distinguish, so only run the split +# assertions elsewhere. +my $HAS_SPLIT = $^O !~ /\A(?:MSWin32|NT|dos|os2|VMS|qnx|cygwin|amigaos)\z/; + +my $tmp = tempdir(CLEANUP => 1); + +# Build our own symlink instead of relying on the test runner's cwd (or on +# /tmp happening to be a symlink, which is true on darwin but not on Linux). +my $real = "$tmp/real"; +my $link = "$tmp/link"; +mkdir $real or die "mkdir $real: $!"; +if (!symlink($real, $link)) { + plan skip_all => "symlinks unavailable: $!"; +} + +my $physical = Cwd::abs_path($real); +plan skip_all => "cannot resolve $real" unless defined $physical && length $physical; + +# abs_path() of the symlink must agree: this is the physical answer. +is(Cwd::abs_path($link), $physical, 'abs_path resolves the symlink'); + +my $origin = Cwd::getcwd(); +chdir $link or plan skip_all => "cannot chdir to $link: $!"; + +# getcwd()/fastcwd() are physical no matter what the environment claims. +{ + local $ENV{PWD} = $link; + is(Cwd::getcwd(), $physical, 'getcwd() is physical'); + is(Cwd::fastcwd(), $physical, 'fastcwd() is physical'); + + if ($HAS_SPLIT) { + is(Cwd::cwd(), $link, 'cwd() honours a valid $ENV{PWD} (logical)'); + is(Cwd::fastgetcwd(), $link, 'fastgetcwd() honours a valid $ENV{PWD}'); + } + else { + is(Cwd::cwd(), $physical, 'cwd() is physical on this platform'); + is(Cwd::fastgetcwd(), $physical, 'fastgetcwd() is physical on this platform'); + } +} + +# A $ENV{PWD} that does not name the current directory must never be trusted: +# cwd() falls back to the physical path. This is what keeps a stale value left +# behind by a plain chdir, or a hostile one, from making cwd() lie. +my %untrusted = ( + 'a stale but existing directory' => $tmp, + 'a nonexistent path' => "$tmp/no-such-directory", + 'a relative path' => 'link', + 'an empty string' => '', +); +for my $why (sort keys %untrusted) { + local $ENV{PWD} = $untrusted{$why}; + is(Cwd::cwd(), $physical, "cwd() ignores $why"); + is(Cwd::fastgetcwd(), $physical, "fastgetcwd() ignores $why"); +} + +# With PWD absent there is no logical answer at all. +{ + my $saved = delete $ENV{PWD}; + is(Cwd::cwd(), $physical, 'cwd() falls back to the physical path with no $ENV{PWD}'); + is(Cwd::fastgetcwd(), $physical, 'fastgetcwd() falls back with no $ENV{PWD}'); + $ENV{PWD} = $saved if defined $saved; +} + +# Any symlinked alias of the current directory is a legitimate logical answer, +# because the trust test compares the directories themselves (device+inode), +# not the spelling of the path. +if ($HAS_SPLIT) { + my $alias = "$tmp/alias"; + if (symlink($real, $alias)) { + local $ENV{PWD} = $alias; + is(Cwd::cwd(), $alias, 'cwd() accepts a different symlink to the same directory'); + } +} + +chdir $origin or die "cannot chdir back to $origin: $!"; + +done_testing; From e789c6be5ab7b260dd1c524fb32a4acc9c83c27d Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Fri, 28 Aug 2026 17:52:29 +0200 Subject: [PATCH 3/4] fix: propagate File::Spec argument taint under -T The Java-backed File::Spec canonpath, catdir and catfile built their answer from fresh scalars, so every path component's taint was dropped. Because the bundled File/Spec/Unix.pm keeps those three Java methods and implements the rest in Perl on top of them, that one gap silently laundered the whole module: rel2abs('x') and abs2rel('x') came back clean even though both resolve their base through Cwd::getcwd(), which is operating-system data and tainted in standard Perl. Carry the taint of the supplied path components onto the result of those three methods. The Perl originals build their answers with join, s/// and string concatenation, all of which propagate taint, so this restores standard Perl behavior for the whole module without introducing taint of its own: - rel2abs/abs2rel taint only when Cwd::getcwd() actually contributes to the answer, and stay clean when an absolute base makes it unnecessary or when the cwd components cancel out of an abs2rel difference. - tmpdir stays clean, since File::Spec::Unix::_tmpdir already discards tainted %ENV candidates under -T. - splitpath keeps laundering through its regexp captures, and path() keeps returning tainted $ENV{PATH} entries. Add taint_filespec.t covering the matrix that was recorded from system perl 5.42 under -T: rel2abs and abs2rel with relative and absolute paths and bases, the constant accessors, canonpath, catfile, catdir, catpath, splitpath, splitdir, file_name_is_absolute, no_upwards, tmpdir, path, and taint propagation from tainted arguments. Sixteen of its assertions fail without this change. Co-Authored-By: Claude Opus 5 (1M context) --- docs/about/changelog.md | 3 + .../runtime/perlmodule/FileSpec.java | 57 +++++-- src/test/resources/unit/taint_filespec.t | 141 ++++++++++++++++++ 3 files changed, 191 insertions(+), 10 deletions(-) create mode 100644 src/test/resources/unit/taint_filespec.t diff --git a/docs/about/changelog.md b/docs/about/changelog.md index 59daff794..e22dbe270 100644 --- a/docs/about/changelog.md +++ b/docs/about/changelog.md @@ -39,6 +39,9 @@ Release history of PerlOnJava. See [Roadmap](roadmap.md) for future plans. - Distinguish the logical from the physical current directory in `Cwd`: `cwd` and `fastgetcwd` now report a validated `$ENV{PWD}` while `getcwd` and `fastcwd` stay physical, matching standard Perl on Unix-like platforms. +- Propagate argument taint through `File::Spec` `canonpath`, `catdir`, and + `catfile`, so `rel2abs`/`abs2rel` taint their `Cwd`-derived results under + `-T` like standard Perl. - Preserve the lifetime of borrowed `+>&=` filehandle aliases, restoring `Tie::File::Indexed` file-backed array storage. - Add a pure-Perl `JSON::Parse` compatibility layer backed by bundled `JSON::PP`. diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/FileSpec.java b/src/main/java/org/perlonjava/runtime/perlmodule/FileSpec.java index 254d110a7..22c093a8d 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/FileSpec.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/FileSpec.java @@ -23,6 +23,11 @@ * path handling. * *

Extends {@link PerlModuleBase} to leverage module initialization and method registration.

+ * + *

The bundled {@code File/Spec/Unix.pm} installs {@code canonpath}, {@code catdir} and + * {@code catfile} with {@code *name = \&_pp_name unless defined &name}, so those three keep the + * Java implementations below. Every other sub in that file is defined unconditionally and + * therefore shadows the Java method of the same name once {@code File::Spec} is loaded.

*/ public class FileSpec extends PerlModuleBase { @@ -77,6 +82,33 @@ public static void initialize() { } } + /** + * Wraps a freshly built path in a {@link RuntimeList}, carrying over the taint of every + * path component the caller supplied. + * + *

The Perl originals of these methods build their answer with {@code join}, {@code s///} + * and string concatenation, all of which propagate taint, so a tainted component must taint + * the result here too. Only the caller's arguments are considered: none of these methods + * consults the operating system, so none of them introduces taint of its own. The invocant + * in {@code args[0]} is a class name or object and is never part of the result.

+ * + * @param result The path value produced by the Java implementation. + * @param args The full argument array, including the invocant at index 0. + * @return A {@link RuntimeList} holding the possibly tainted result. + */ + private static RuntimeList withArgumentTaint(RuntimeScalar result, RuntimeArray args) { + int count = args.size() - 1; + if (count <= 0) { + return result.getList(); + } + RuntimeScalar[] inputs = new RuntimeScalar[count]; + for (int i = 0; i < count; i++) { + inputs[i] = args.get(i + 1); + } + // propagateTaint() may hand back a different scalar, so use its return value. + return result.propagateTaint(inputs).getList(); + } + /** * Converts a path to a canonical form, removing redundant separators and up-level references. * @@ -92,9 +124,9 @@ public static RuntimeList canonpath(RuntimeArray args, int ctx) { // Empty string stays empty (Perl 5 behavior) if (path.isEmpty()) { - return new RuntimeScalar("").getList(); + return withArgumentTaint(new RuntimeScalar(""), args); } - + // These Java methods are installed in File::Spec::Unix. Platform // subclasses (including File::Spec::Win32) override them in Perl, so // their behavior must remain Unix-specific even on a Windows host. @@ -113,8 +145,8 @@ public static RuntimeList canonpath(RuntimeArray args, int ctx) { if (canonPath.isEmpty()) { canonPath = "."; } - - return new RuntimeScalar(canonPath).getList(); + + return withArgumentTaint(new RuntimeScalar(canonPath), args); } /** @@ -176,7 +208,10 @@ public static RuntimeList catdir(RuntimeArray args, int ctx) { RuntimeArray canonArgs = new RuntimeArray(); canonArgs.push(new RuntimeScalar("dummy")); canonArgs.push(new RuntimeScalar(result.toString())); - return canonpath(canonArgs, ctx); + String canonical = canonpath(canonArgs, ctx).elements.get(0).toString(); + // The intermediate scalars above are clean, so the taint of the caller's + // components has to be re-applied to the final answer. + return withArgumentTaint(new RuntimeScalar(canonical), args); } /** @@ -193,7 +228,7 @@ public static RuntimeList catfile(RuntimeArray args, int ctx) { if (args.size() == 2) { return canonpath(args, ctx); } - return new RuntimeScalar("").getList(); + return withArgumentTaint(new RuntimeScalar(""), args); } // Last real arg is the file component; everything before is directories @@ -219,17 +254,19 @@ public static RuntimeList catfile(RuntimeArray args, int ctx) { String filePart = canonpath(fileCanonArgs, ctx).elements.get(0).toString(); // Combine: if dir is empty, just return the file + // The catdir/canonpath calls above ran on clean copies, so the caller's + // taint is re-applied to whichever combination is returned. if (dir.isEmpty()) { - return new RuntimeScalar(filePart).getList(); + return withArgumentTaint(new RuntimeScalar(filePart), args); } - + // Ensure proper separator between dir and file String separator = "/"; char lastChar = dir.charAt(dir.length() - 1); if (lastChar == '/' || lastChar == '\\') { - return new RuntimeScalar(dir + filePart).getList(); + return withArgumentTaint(new RuntimeScalar(dir + filePart), args); } - return new RuntimeScalar(dir + separator + filePart).getList(); + return withArgumentTaint(new RuntimeScalar(dir + separator + filePart), args); } /** diff --git a/src/test/resources/unit/taint_filespec.t b/src/test/resources/unit/taint_filespec.t new file mode 100644 index 000000000..ab92bcf05 --- /dev/null +++ b/src/test/resources/unit/taint_filespec.t @@ -0,0 +1,141 @@ +#!perl -T +use strict; +use warnings; +use File::Spec (); +use Scalar::Util qw(tainted); +use Test::More; + +# File::Spec derives its answers from its arguments and, for the methods that +# need a base directory, from Cwd::getcwd(). The current directory is +# operating-system data, so standard Perl taints exactly those results and +# leaves the purely lexical path manipulations clean. Every expectation below +# was recorded from system perl 5.42 under -T before being used to drive the +# PerlOnJava fix; keep them in sync with real perl, not with PerlOnJava. + +# A tainted string to feed through the path-manipulation methods. +my $dirty = $ENV{PATH}; +ok(tainted($dirty), '$ENV{PATH} is tainted under -T'); + +# A top-level name that will not collide with a real component of the +# directory the test happens to run in, so the abs2rel expectations below stay +# independent of the checkout location. +my $abs = '/zzz_taint_probe/leaf'; + +# --------------------------------------------------------------------------- +# rel2abs: taints exactly when the current directory has to be consulted. +# --------------------------------------------------------------------------- +ok(tainted(File::Spec->rel2abs('x')), + "rel2abs('x') is tainted: the missing base comes from getcwd()"); +ok(!tainted(File::Spec->rel2abs($abs)), + 'rel2abs() of an absolute path is clean: no base is needed'); +ok(!tainted(File::Spec->rel2abs('x', '/base')), + 'rel2abs() with an absolute base is clean'); +ok(!tainted(File::Spec->rel2abs($abs, '/base')), + 'rel2abs() with an absolute path and base is clean'); +ok(tainted(File::Spec->rel2abs('x', 'rel_base')), + 'rel2abs() with a relative base is tainted: the base is resolved via getcwd()'); +ok(tainted(File::Spec->rel2abs('x', '')), + "rel2abs() with an empty base falls back to getcwd() and is tainted"); +ok(tainted(File::Spec->rel2abs('.')), + "rel2abs('.') is tainted"); + +# --------------------------------------------------------------------------- +# abs2rel: the getcwd()-derived components cancel out against each other, so +# only a relative *path* argument leaves operating-system data in the answer. +# --------------------------------------------------------------------------- +ok(!tainted(File::Spec->abs2rel($abs)), + 'abs2rel() of an absolute path is clean even though the base is getcwd()'); +ok(tainted(File::Spec->abs2rel('x')), + 'abs2rel() of a relative path is tainted: the path is resolved via getcwd()'); +ok(!tainted(File::Spec->abs2rel($abs, '/base')), + 'abs2rel() with an absolute path and base is clean'); +ok(tainted(File::Spec->abs2rel('x', '/base')), + 'abs2rel() of a relative path against an absolute base is tainted'); +ok(!tainted(File::Spec->abs2rel($abs, 'rel_base')), + 'abs2rel() with a relative base is clean: the base taint cancels out'); +ok(!tainted(File::Spec->abs2rel('/a/b', '/a/b')), + 'abs2rel() of equal paths returns a clean curdir'); + +# --------------------------------------------------------------------------- +# Constants and lexical manipulations: never tainted for clean inputs. +# --------------------------------------------------------------------------- +ok(!tainted(File::Spec->curdir), 'curdir is clean'); +ok(!tainted(File::Spec->updir), 'updir is clean'); +ok(!tainted(File::Spec->rootdir), 'rootdir is clean'); +ok(!tainted(File::Spec->devnull), 'devnull is clean'); +ok(!tainted(File::Spec->case_tolerant), 'case_tolerant is clean'); +ok(!tainted(File::Spec->canonpath('a/./b')), 'canonpath() of a clean path is clean'); +ok(!tainted(File::Spec->canonpath('')), 'canonpath() of the empty string is clean'); +ok(!tainted(File::Spec->catfile('a', 'b')), 'catfile() of clean parts is clean'); +ok(!tainted(File::Spec->catdir('a', 'b')), 'catdir() of clean parts is clean'); +ok(!tainted(File::Spec->catdir()), 'catdir() with no arguments is clean'); +ok(!tainted(File::Spec->join('a', 'b')), 'join() of clean parts is clean'); +ok(!tainted(File::Spec->catpath('', 'a/b', 'c')), 'catpath() of clean parts is clean'); +ok(!tainted(File::Spec->file_name_is_absolute('/x')), + 'file_name_is_absolute() returns a clean boolean for a clean path'); +ok(!tainted(File::Spec->file_name_is_absolute($dirty)), + 'file_name_is_absolute() returns a clean boolean even for a tainted path'); +ok(!tainted((File::Spec->no_upwards('a', '..'))[0]), 'no_upwards() keeps clean names clean'); +ok(!tainted($_), 'splitpath() of a clean path is clean') for File::Spec->splitpath('/a/b/c'); +ok(!tainted($_), 'splitdir() of a clean path is clean') for File::Spec->splitdir('/a/b/c'); + +# tmpdir consults %ENV, but File::Spec::Unix::_tmpdir discards every tainted +# candidate under -T and falls back to the hard-coded directory, so the result +# is clean. Over-tainting it would break callers that open temporary files. +my $tmpdir = File::Spec->tmpdir; +ok(defined $tmpdir && length $tmpdir, 'tmpdir returns a path'); +ok(!tainted($tmpdir), 'tmpdir is clean under -T: tainted %ENV candidates are dropped'); + +# path() is the one method that hands back %ENV data verbatim. +my @path = File::Spec->path(); +SKIP: { + skip 'no PATH entries to check', 1 unless @path; + ok(tainted($path[0]), 'path() returns tainted entries: it splits $ENV{PATH}'); +} + +# --------------------------------------------------------------------------- +# Taint propagation from the caller's arguments. +# --------------------------------------------------------------------------- +ok(tainted(File::Spec->canonpath($dirty)), 'canonpath() propagates argument taint'); +ok(tainted(File::Spec->catfile($dirty, 'x')), 'catfile() propagates taint from a directory'); +ok(tainted(File::Spec->catfile('x', $dirty)), 'catfile() propagates taint from the file'); +ok(tainted(File::Spec->catdir($dirty, 'x')), 'catdir() propagates argument taint'); +ok(tainted(File::Spec->join($dirty, 'x')), 'join() propagates argument taint'); +ok(tainted(File::Spec->rel2abs($dirty, '/base')), 'rel2abs() propagates path taint'); +ok(tainted(File::Spec->rel2abs('x', $dirty)), 'rel2abs() propagates base taint'); +ok(tainted(File::Spec->abs2rel($dirty, '/base')), 'abs2rel() propagates path taint'); +ok(tainted(File::Spec->catpath('', $dirty, 'c')), 'catpath() propagates directory taint'); +ok(tainted((File::Spec->no_upwards($dirty))[0]), 'no_upwards() passes tainted names through'); +ok(tainted($_), 'splitdir() propagates argument taint') for File::Spec->splitdir($dirty); + +# splitpath() extracts its fields with a regexp match, and captures launder +# taint unless "use re 'taint'" is in effect, so the pieces come back clean. +ok(!tainted($_), 'splitpath() launders taint through its captures') + for File::Spec->splitpath($dirty); + +# With $no_file the directory field is the argument itself, not a capture. +{ + my ($volume, $directory, $file) = File::Spec->splitpath($dirty, 1); + ok(!tainted($volume), 'splitpath($path, 1) returns a clean volume'); + ok(tainted($directory), 'splitpath($path, 1) hands back the tainted path as the directory'); + ok(!tainted($file), 'splitpath($path, 1) returns a clean file'); +} + +SKIP: { + skip 'volume is significant outside Unix', 1 if $^O eq 'MSWin32'; + ok(!tainted(File::Spec->catpath($dirty, 'a', 'b')), + 'catpath() ignores the volume on Unix, so its taint does not reach the result'); +} + +# A getcwd()-derived path cannot reach an operation that touches the file +# system without being laundered first. +my $chdir_ok = eval { chdir File::Spec->rel2abs('.'); 1 }; +ok(!$chdir_ok, "chdir rejects the tainted rel2abs('.') value"); +like($@, qr/^Insecure dependency in chdir while running with -T switch/, + 'chdir reports the Perl security error for a tainted directory'); + +my ($laundered) = File::Spec->rel2abs('.') =~ /\A(.*)\z/s; +ok(!tainted($laundered), 'a laundered rel2abs() result is clean'); +ok(chdir($laundered), 'the laundered directory can be used with chdir'); + +done_testing; From 0707bc70863b07f1dca3ea89be05e64847ad312a Mon Sep 17 00:00:00 2001 From: "Flavio S. Glock" Date: Mon, 31 Aug 2026 12:04:01 +0200 Subject: [PATCH 4/4] fix: preserve File::Spec taint on Windows Keep taint metadata through the File::Spec::Win32 path constructors and correct the platform-specific path() regression assertion: Windows prepends a clean literal curdir before PATH-derived entries. Generated with [Codex](https://openai.com/codex/) Co-Authored-By: Codex --- .../runtime/perlmodule/Internals.java | 22 +++++++ src/main/perl/lib/File/Spec/Win32.pm | 58 ++++++++++++++----- src/test/resources/unit/taint_filespec.t | 15 ++++- 3 files changed, 77 insertions(+), 18 deletions(-) diff --git a/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java b/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java index d84c86e3f..9858bc756 100644 --- a/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java +++ b/src/main/java/org/perlonjava/runtime/perlmodule/Internals.java @@ -63,6 +63,7 @@ public static void initialize() { internals.registerMethod("V", "V", null); internals.registerMethod("getcwd", "getcwd", null); internals.registerMethod("logical_cwd", "logical_cwd", null); + internals.registerMethod("taint_propagate", "taintPropagate", "@"); internals.registerMethod("abs_path", "abs_path", ";$"); // PerlOnJava-only probe: report whether a fully qualified sub // name was installed via typeglob assignment (e.g. Exporter @@ -955,6 +956,27 @@ public static RuntimeList logical_cwd(RuntimeArray args, int ctx) { .getList(); } + /** + * Returns a copy of a computed value with taint propagated from the supplied + * source values. Bundled Perl modules use this at platform boundaries where + * a path is assembled in Perl but the individual string operations have not + * retained the source scalar's taint metadata. + * + * @param args the computed value followed by zero or more taint sources + * @param ctx the calling context + * @return the computed value, with taint from any source preserved + */ + public static RuntimeList taintPropagate(RuntimeArray args, int ctx) { + if (args.size() == 0) { + return new RuntimeScalar().getList(); + } + RuntimeScalar result = new RuntimeScalar(args.get(0)); + for (int i = 1; i < args.size(); i++) { + result = result.propagateTaint(args.get(i)); + } + return result.getList(); + } + /** * Returns {@code $ENV{PWD}} when it can stand in for the physical current * directory, or {@code null} when it cannot be trusted. diff --git a/src/main/perl/lib/File/Spec/Win32.pm b/src/main/perl/lib/File/Spec/Win32.pm index 3964b01dd..2d072cf2c 100644 --- a/src/main/perl/lib/File/Spec/Win32.pm +++ b/src/main/perl/lib/File/Spec/Win32.pm @@ -15,6 +15,15 @@ my $DRIVE_RX = '[a-zA-Z]:'; my $UNC_RX = '(?:\\\\\\\\|//)[^\\\\/]+[\\\\/][^\\\\/]+'; my $VOL_RX = "(?:$DRIVE_RX|$UNC_RX)"; +# The Java-backed File::Spec::Unix methods retain taint explicitly. Win32 +# overrides several of them in Perl, where the intermediate regex and string +# operations can otherwise lose a caller's taint metadata. Preserve it at the +# public method boundary, matching native Perl's path operations. +sub _taint_result { + my ($result, @sources) = @_; + return Internals::taint_propagate($result, @sources); +} + =head1 NAME @@ -133,42 +142,46 @@ complete path ending with a filename sub catfile { shift; + my @sources = @_; # Legacy / compatibility support # - shift, return _canon_cat( "/", @_ ) + shift, return _taint_result(_canon_cat( "/", @_ ), @sources) if !@_ || $_[0] eq ""; # Compatibility with File::Spec <= 3.26: # catfile('A:', 'foo') should return 'A:\foo'. - return _canon_cat( ($_[0].'\\'), @_[1..$#_] ) + return _taint_result(_canon_cat( ($_[0].'\\'), @_[1..$#_] ), @sources) if $_[0] =~ m{^$DRIVE_RX\z}o; - return _canon_cat( @_ ); + return _taint_result(_canon_cat( @_ ), @sources); } sub catdir { shift; + my @sources = @_; # Legacy / compatibility support # - return "" + return _taint_result("") unless @_; - shift, return _canon_cat( "/", @_ ) + shift, return _taint_result(_canon_cat( "/", @_ ), @sources) if $_[0] eq ""; # Compatibility with File::Spec <= 3.26: # catdir('A:', 'foo') should return 'A:\foo'. - return _canon_cat( ($_[0].'\\'), @_[1..$#_] ) + return _taint_result(_canon_cat( ($_[0].'\\'), @_[1..$#_] ), @sources) if $_[0] =~ m{^$DRIVE_RX\z}o; - return _canon_cat( @_ ); + return _taint_result(_canon_cat( @_ ), @sources); } sub path { - my @path = split(';', $ENV{PATH}); + my $env_path = $ENV{PATH}; + my @path = split(';', $env_path); s/"//g for @path; @path = grep length, @path; + @path = map { _taint_result($_, $env_path) } @path; unshift(@path, "."); return @path; } @@ -187,8 +200,8 @@ On Win32 makes sub canonpath { # Legacy / compatibility support # - return $_[1] if !defined($_[1]) or $_[1] eq ''; - return _canon_cat( $_[1] ); + return _taint_result($_[1], $_[1]) if !defined($_[1]) or $_[1] eq ''; + return _taint_result(_canon_cat( $_[1] ), $_[1]); } =item splitpath @@ -218,7 +231,9 @@ sub splitpath { $path =~ m{^ ( $VOL_RX ? ) (.*) }sox; $volume = $1; - $directory = $2; + # Unlike the capture-derived fields, the no-file directory is the + # caller's path itself and must retain its taint. + $directory = _taint_result($2, $path); } else { $path =~ @@ -234,6 +249,12 @@ sub splitpath { return ($volume,$directory,$file); } +sub join { + shift; + my @sources = @_; + return _taint_result(_canon_cat(@_), @sources); +} + =item splitdir @@ -289,6 +310,7 @@ the $volume become significant. sub catpath { my ($self,$volume,$directory,$file) = @_; + my @sources = ($volume, $directory, $file); # If it's UNC, make sure the glue separator is there, reusing # whatever separator is first in the $volume @@ -313,7 +335,7 @@ sub catpath { $volume .= $file ; - return $volume ; + return _taint_result($volume, @sources); } sub _same { @@ -326,12 +348,12 @@ sub rel2abs { my $is_abs = $self->file_name_is_absolute($path); # Check for volume (should probably document the '2' thing...) - return $self->canonpath( $path ) if $is_abs == 2; + return _taint_result($self->canonpath( $path ), $path, $base) if $is_abs == 2; if ($is_abs) { # It's missing a volume, add one my $vol = ($self->splitpath( Cwd::getcwd() ))[0]; - return $self->canonpath( $vol . $path ); + return _taint_result($self->canonpath( $vol . $path ), $path, $vol); } if ( !defined( $base ) || $base eq '' ) { @@ -357,7 +379,13 @@ sub rel2abs { $path_file ) ; - return $self->canonpath( $path ) ; + return _taint_result($self->canonpath( $path ), $path, $base); +} + +sub abs2rel { + my ($self, $path, $base) = @_; + my $result = File::Spec::Unix::abs2rel(@_); + return _taint_result($result, $path, $base); } =back diff --git a/src/test/resources/unit/taint_filespec.t b/src/test/resources/unit/taint_filespec.t index ab92bcf05..a92f361d2 100644 --- a/src/test/resources/unit/taint_filespec.t +++ b/src/test/resources/unit/taint_filespec.t @@ -86,11 +86,20 @@ my $tmpdir = File::Spec->tmpdir; ok(defined $tmpdir && length $tmpdir, 'tmpdir returns a path'); ok(!tainted($tmpdir), 'tmpdir is clean under -T: tainted %ENV candidates are dropped'); -# path() is the one method that hands back %ENV data verbatim. +# path() is the one method that hands back %ENV data verbatim. Win32 adds a +# clean literal "." ahead of the environment-derived entries, so check its +# first PATH entry rather than assuming index zero is from %ENV. my @path = File::Spec->path(); SKIP: { - skip 'no PATH entries to check', 1 unless @path; - ok(tainted($path[0]), 'path() returns tainted entries: it splits $ENV{PATH}'); + if ($^O eq 'MSWin32') { + skip 'no PATH entry after Win32 curdir', 2 unless @path > 1; + ok(!tainted($path[0]), 'Win32 path() prepends a clean curdir'); + ok(tainted($path[1]), 'Win32 path() keeps PATH-derived entries tainted'); + } + else { + skip 'no PATH entries to check', 1 unless @path; + ok(tainted($path[0]), 'path() returns tainted entries: it splits $ENV{PATH}'); + } } # ---------------------------------------------------------------------------