X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2F_Util.pm;h=f86be002e19b514508cbfe8334c4a499c6ddbe34;hb=7648acb5dd1f2f281ca84e2152efe314bcbf2c70;hp=a8785c08c567ea216429c15897ac2bb37dd0948d;hpb=86a432d4cc096062e2374f118ce38aa131799d6a;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/_Util.pm b/lib/DBIx/Class/_Util.pm
index a8785c0..f86be00 100644
--- a/lib/DBIx/Class/_Util.pm
+++ b/lib/DBIx/Class/_Util.pm
@@ -34,6 +34,8 @@ BEGIN {
 
     HAS_ITHREADS => $Config{useithreads} ? 1 : 0,
 
+    TAINT_MODE => 0 + ${^TAINT}, # tri-state: 0, 1, -1
+
     UNSTABLE_DOLLARAT => ( PERL_VERSION < 5.013002 ) ? 1 : 0,
 
     ( map
@@ -173,10 +175,17 @@ use B ();
 use Carp 'croak';
 use Storable 'nfreeze';
 use Scalar::Util qw(weaken blessed reftype refaddr);
-use Sub::Quote qw(qsub);
 use Sub::Name ();
 use attributes ();
 
+# Usually versions are not specified anywhere aside the Makefile.PL
+# (writing them out in-code is extremely obnoxious)
+# However without a recent enough Moo the quote_sub override fails
+# in very puzzling and hard to detect ways: so add a version check
+# just this once
+use Sub::Quote qw(qsub);
+BEGIN { Sub::Quote->VERSION('2.002002') }
+
 # Already correctly prototyped: perlbrew exec perl -MStorable -e 'warn prototype \&Storable::dclone'
 BEGIN { *deep_clone = \&Storable::dclone }
 
@@ -757,6 +766,16 @@ sub modver_gt_or_eq_and_lt ($$$) {
     croak "Expecting a class name either as the sole argument or a 'class' option"
       if not defined $class or $class !~ $module_name_rx;
 
+    croak(
+      "The supplied 'class' argument is tainted: this is *extremely* "
+    . 'dangerous, fix your code ASAP!!! ( for more details read through '
+    . 'https://is.gd/perl_mro_taint_wtf )'
+    ) if (
+      DBIx::Class::_ENV_::TAINT_MODE
+        and
+      Scalar::Util::tainted($class)
+    );
+
     $requested_mro ||= mro::get_mro($class);
 
     # mro::set_mro() does not bump pkg_gen - WHAT THE FUCK?!
@@ -899,7 +918,7 @@ sub modver_gt_or_eq_and_lt ($$$) {
       if (
         ! DBIx::Class::_ENV_::OLD_MRO
           and
-        ${^TAINT}
+        DBIx::Class::_ENV_::TAINT_MODE
       ) {
 
         $slot->{cumulative_gen} = 0;