The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
#!perl -w   -- -*- tab-width: 4; mode: perl -*-
# [no -T]: Test::Distribution is File::Find tainted (Insecure dependency in chdir...)

use strict;
use warnings;

{
## no critic ( ProhibitOneArgSelect RequireLocalizedPunctuationVars )
my $fh = select STDIN; $|++; select STDOUT; $|++; select STDERR; $|++; select $fh;	# DISABLE buffering on STDIN, STDOUT, and STDERR
}

use Test::More;

plan skip_all => 'TAINT mode not supported (Test::Distribution is File::Find tainted)' if in_taint_mode();
plan skip_all => 'Author tests [to run: set TEST_AUTHOR]' unless $ENV{TEST_AUTHOR} or $ENV{TEST_ALL};

my $haveTestDistribution = eval { require Test::Distribution; 1; };

plan skip_all => 'Test::Distribution required to run distribution tests' if !$haveTestDistribution;

import Test::Distribution;


#### SUBs ---------------------------------------------------------------------------------------##


sub is_tainted {
	## no critic ( ProhibitStringyEval RequireCheckingReturnValueOfEval ) # ToDO: remove/revisit
	# URLref: [perlsec - Laundering and Detecting Tainted Data] http://perldoc.perl.org/perlsec.html#Laundering-and-Detecting-Tainted-Data
    return ! eval { eval(q{#} . substr(join(q{}, @_), 0, 0)); 1 };
    }

sub in_taint_mode {
	## no critic ( RequireBriefOpen RequireInitializationForLocalVars ProhibitStringyEval RequireCheckingReturnValueOfEval ProhibitBarewordFileHandles ProhibitTwoArgOpen ) # ToDO: remove/revisit
	# modified from Taint source @ URLref: http://cpansearch.perl.org/src/PHOENIX/Taint-0.09/Taint.pm
	my $taint = q{};

	if (not is_tainted( $taint )) {
		$taint = substr("$0$^X", 0, 0);
		}

	if (not is_tainted( $taint )) {
		$taint = substr(join("", @ARGV, %ENV), 0, 0);
		}

	if (not is_tainted( $taint )) {
		local(*FILE);
		my $data = q{};
		for (qw(/dev/null nul / . ..), values %INC, $0, $^X) {
			# Why so many? Maybe a file was just deleted or moved;
			# you never know! :-)  At this point, taint checks
			# are probably off anyway, but this is the ironclad
			# way to get tainted data if it's possible.
			# (Yes, even reading from /dev/null works!)
			#
			last if open FILE, $_
			and defined sysread FILE, $data, 1
			}
		close( FILE );
		$taint = substr($data, 0, 0);
		}

	return is_tainted( $taint );
	}