Implement is_tainted(), taint() and untaint(). [github 71]

Turns out you CAN taint a reference, so this works with objects.  Edge cases
around overloaded objects are covered.

autoboxed bare hashes and arrays cannot be made tained because of a bug/limitation
in Taint::Util. See http://rt.cpan.org/Ticket/Display.html?id=53988

Build.PL

@@ -33,6 +33,7 @@ my $builder = MyBuild->new(
         'autovivification'    => '0.04',
         'version'             => '0.77',
         'Perl6::Caller'       => '0.100',
+        "Taint::Util"         => '0.06',
     },
     build_requires => {
         'ExtUtils::CBuilder' => '0.26',

lib/Object.pm

@@ -3,7 +3,10 @@ package Object;
 use strict;
 use warnings;
 
-use Scalar::Util ();
+# Be very careful not to import anything.
+require Scalar::Util;
+require Carp;
+require Taint::Util;
 
 {
     package UNIVERSAL;
@@ -56,6 +59,95 @@ sub class {
 }
 
 
+=head2 is_tainted
+
+    my $is_tainted = $object->is_tainted;
+
+Returns true if the $object is tainted.
+
+Only scalars can be tainted, so objects generally return false.
+
+String and numerically overloaded objects will check against their
+overloaded versions.
+
+=cut
+
+# Returns the code which will run when the object is used as a string
+my $has_string_overload = sub {
+    return overload::Method($_[0], q[""]) || overload::Method($_[0], q[0+])
+};
+
+sub is_tainted {
+    my $code;
+
+    if( $code = overload::Method($_[0], q[""]) ) {
+        return Taint::Util::tainted($code->($_[0]));
+    }
+    elsif( $code = overload::Method($_[0], "0+") ) {
+        # Don't do a +0 as that might trigger a + operation which
+        # might be seperately overloaded, or as in DateTime just die.
+        return Taint::Util::tainted($code->($_[0]));
+    }
+    else {
+        return Taint::Util::tainted($_[0]);
+    }
+
+    die "Never should be reached";
+}
+
+
+=head2 taint
+
+    $object->taint;
+
+Taints the $object.
+
+Normally only scalars can be tainted, this will throw an exception on
+anything else.
+
+An object can override this method if they have a means of tainting
+themselves.  Generally this is applicable to string or numeric
+overloaded objects who can taint their overloaded value.
+
+=cut
+
+sub taint {
+    if( $_[0]->$has_string_overload ) {
+        Carp::croak "Overloaded objects cannot be made tainted" unless $_[0]->is_tainted;
+        return 1;
+    }
+
+    Taint::Util::taint($_[0]);
+    return 1;
+}
+
+=head2 untaint
+
+    $object->untaint;
+
+Untaints the $object.
+
+Normally objects cannot be tainted, so it is a no op on anything but a
+scalar.
+
+String and numeric overloaded objects are an exception.  If an object
+is string or numeric overloaded, and it is tainted, this method will
+throw an exception.  The overloaded class may override this method to
+provide their own untainting mechanism.
+
+=cut
+
+sub untaint {
+    if( $_[0]->$has_string_overload ) {
+        Carp::croak "Overloaded objects cannot be untainted" if $_[0]->is_tainted;
+        return 1;
+    }
+    else {
+        return 1;
+    }
+}
+
+
 =head2 reftype
 
     my $reftype = $object->reftype;

lib/perl5i/SCALAR.pm

@@ -6,7 +6,7 @@ use strict;
 use warnings;
 use Carp;
 use Module::Load;
-
+use Taint::Util;
 
 sub SCALAR::title_case {
     my ($string) = @_;
@@ -83,5 +83,21 @@ sub SCALAR::wrap {
 }
 
 
+sub SCALAR::untaint {
+    Taint::Util::untaint($_[0]);
+    return 1;
+}
+
+
+sub SCALAR::taint {
+    Taint::Util::taint($_[0]);
+    return 1;
+}
+
+# Could use the version in Object but this removes the need to check
+# for overloading.
+sub SCALAR::is_tainted {
+    return Taint::Util::tainted($_[0]);
+}
 
 1;

t/taint.t

@@ -0,0 +1,150 @@
+#!/usr/bin/perl -T
+
+use perl5i;
+use Test::More;
+use Test::Exception;
+
+use Scalar::Util qw(tainted);
+
+
+# Check an already tainted global
+{
+    ok $^X->is_tainted;
+
+    $^X->untaint;
+    ok !$^X->is_tainted;
+    ok !tainted($^X);
+
+    $^X->taint;
+    ok $^X->is_tainted;
+    ok tainted($^X);
+}
+
+
+# Check a scalar
+{
+    my $foo = 42;
+    ok !$foo->is_tainted;
+
+    $foo->taint;
+    ok $foo->is_tainted;
+    ok tainted($foo);  # just to be sure.
+
+    $foo->untaint;
+    ok !$foo->is_tainted;
+    ok !tainted($foo);  # just to be sure.
+}
+
+
+# What about a scalar ref?
+# Should we check against its contents?
+{
+    my $foo = \42;
+    ok !$foo->is_tainted;
+
+    $foo->taint;
+    ok $foo->is_tainted;
+    ok tainted($foo);  # just to be sure.
+
+    $foo->untaint;
+    ok !$foo->is_tainted;
+    ok !tainted($foo);  # just to be sure.
+}
+
+
+# A regular hash cannot be tainted
+{
+    my %foo;
+    ok !%foo->is_tainted;
+
+    %foo->untaint;  # does nothing
+    ok !%foo->is_tainted;
+    ok !tainted(\%foo);  # just to be sure.
+
+    %foo->taint;
+
+    TODO: {
+        local $TODO = "Bug in Taint::Util prevents bare hashes and arrays from being tainted";
+        ok %foo->is_tainted;
+        ok tainted(\%foo);  # just to be sure.
+    }
+}
+
+
+# A blessed hash ref object cannot be tainted
+{
+    my $obj = bless {}, "Foo";
+    ok !$obj->is_tainted;
+
+    $obj->untaint;  # does nothing
+    ok !$obj->is_tainted;
+
+    $obj->taint;
+    ok $obj->is_tainted;
+    ok tainted($obj);
+}
+
+
+# A blessed scalar ref object?
+{
+    my $thing = 42;
+    my $obj = bless \$thing, "Foo";
+    ok !$obj->is_tainted;
+
+    $obj->untaint;  # does nothing
+    ok !$obj->is_tainted;
+
+    $obj->taint;
+    ok $obj->is_tainted;
+    ok tainted($obj);
+}
+
+
+# How about a string overloaded object?
+# Since its stringified value is what's important to tainting,
+# we should check that.  But there's no way to reliably taint or untaint it.
+{
+    package Bar;
+    use Test::More;
+    use Test::Exception;
+
+    use overload q[""] => sub { return ${$_[0]} };
+
+    # Try it when its overloaded and tainted
+    {
+        my $thing = $^X;
+        my $obj = bless \$thing, "Bar";
+        is $obj, $^X;
+
+        ok $obj->is_tainted;
+        ok ::tainted("$obj");
+
+        throws_ok { $obj->untaint; } qr/^Overloaded objects cannot be untainted/;
+        ok $obj->taint;  # this is cool, its already tainted.
+    }
+
+    # Overloaded and not tainted
+    {
+        my $thing = "wibble";
+        my $obj = bless \$thing, "Bar";
+        is $obj, $thing;
+
+        ok !$obj->is_tainted;
+        ok !::tainted("$obj");
+
+        ok $obj->untaint;  # this is cool, its already untainted.
+        throws_ok { $obj->taint; } qr/^Overloaded objects cannot be made tainted/;
+    }
+}
+
+
+# DateTime is notoriously picky about its overloading
+# In particular $date+0, the usual way to numify, will die.
+{
+    require DateTime;
+    my $date = DateTime->now;
+
+    ok !$date->is_tainted;
+}
+
+done_testing();