Skip to content

Commit

Permalink
Get rid of Package::Stash \o/
Browse files Browse the repository at this point in the history 
Internal tooling advanced sufficiently without planning for any of that:
a good indicator things are on the right track!

Read under -w
  • Loading branch information
@ribasushi
ribasushi committed Jul 14, 2016
1 parent 86a432d commit b090048
Show file tree
Hide file tree
Showing 4 changed files with 54 additions and 52 deletions.
4 changes: 0 additions & 4 deletions Makefile.PL
View file
Original file line number Diff line number Diff line change
Expand Up @@ -85,10 +85,6 @@ my $test_requires = {
#
'Sub::Uplevel' => '0.19',

# this is already a dep of n::c, but just in case - used by t/55namespaces_cleaned.t
# remove and do a manual glob-collection if n::c is no longer a dep
'Package::Stash' => '0.28',

# needed for testing only, not for operation
# we will move away from this dep eventually, perhaps to DBD::CSV or something
%{ DBIx::Class::Optional::Dependencies->req_list_for('test_rdbms_sqlite') },
Expand Down
2 changes: 1 addition & 1 deletion lib/DBIx/Class/CDBICompat/ColumnGroups.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -98,7 +98,7 @@ sub _register_column_group {
grep {
$_ ne $class
and
($_->can($name)||0) == $existing_accessor
( $Class::C3::MRO{$_} || {} )->{methods}{$name}
} @{mro::get_linear_isa($class)}
)
)
Expand Down
32 changes: 14 additions & 18 deletions lib/DBIx/Class/ResultSetManager.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2,9 +2,8 @@ package DBIx::Class::ResultSetManager;
use strict;
use warnings;
use base 'DBIx::Class';
use Package::Stash ();

use DBIx::Class::_Util 'set_subname';
use DBIx::Class::_Util qw( set_subname describe_class_methods );
use namespace::clean;

warn "DBIx::Class::ResultSetManager never left experimental status and
Expand Down Expand Up @@ -56,25 +55,22 @@ sub _register_attributes {
my $cache = $self->_attr_cache;
return if keys %$cache == 0;

foreach my $meth (keys %{ { map
{ $_ => 1 }
for my $meth(
map
{ Package::Stash->new($_)->list_all_symbols("CODE") }
@{ mro::get_linear_isa( ref $self || $self ) }
} } ) {
# *DO NOT* rely on P::S returning crefs in reverse mro order
# but instead ask the mro to redo the lookup
{ $_->{name} }
grep
{ $_->{attributes}{ResultSet} }
map
{ $_->[0] }
values %{ describe_class_methods( ref $self || $self )->{methods} }
) {
# This codepath is extremely old, miht as well keep it running
# as-is with no room for surprises
my $attrs = $cache->{$self->can($meth)};
next unless $attrs;
if ($attrs->[0] eq 'ResultSet') {
no strict 'refs';
my $resultset_class = $self->_setup_resultset_class;
my $name = join '::',$resultset_class, $meth;
*$name = set_subname $name, $self->can($meth);
delete ${"${self}::"}{$meth};
}
no strict 'refs';
my $resultset_class = $self->_setup_resultset_class;
my $name = join '::',$resultset_class, $meth;
*$name = set_subname $name, $self->can($meth);
delete ${"${self}::"}{$meth};
}
}

Expand Down
68 changes: 39 additions & 29 deletions xt/extra/internals/namespaces_cleaned.t
View file
Original file line number Diff line number Diff line change
Expand Up @@ -35,41 +35,48 @@ BEGIN {
use strict;
use warnings;

# FIXME This is a crock of shit, needs to go away
# currently here to work around https://rt.cpan.org/Ticket/Display.html?id=74151
# kill with fire when PS::XS / RT#74151 is *finally* fixed
BEGIN {
my $PS_provider;

if ( "$]" < 5.010 ) {
require Package::Stash::PP;
$PS_provider = 'Package::Stash::PP';
}
else {
require Package::Stash;
$PS_provider = 'Package::Stash';
}
eval <<"EOS" or die $@;
sub stash_for (\$) {
$PS_provider->new(\$_[0]);
}
1;
EOS
}

use Test::More;

use DBICTest;
use File::Find;
use File::Spec;
use DBIx::Class::_Util 'get_subname';
use DBIx::Class::_Util qw( get_subname describe_class_methods );

# makes sure we can load at least something
use DBIx::Class;
use DBIx::Class::Carp;

my @modules = grep {
my @modules = map {
# FIXME: AS THIS IS CLEARLY A LACK OF DEFENSE IN describe_class_methods :FIXME
# FIXME !!! without this detaint I get the test into an infloop on 5.16.x
# (maybe other versions): https://travis-ci.org/ribasushi/dbix-class/jobs/144738784#L26762
#
# or locally like:
#
# ~$ ulimit -v $(( 1024 * 256 )); perl -d:Confess -Ilib -Tl xt/extra/internals/namespaces_cleaned.t
# ...
# DBIx::Class::MethodAttributes::_attr_cache("DBIx::Class::Storage::DBI::ODBC::Firebird") called at lib/DBIx/Class/MethodAttributes.pm line 166
# DBIx::Class::MethodAttributes::_attr_cache("DBIx::Class::Storage::DBI::ODBC::Firebird") called at lib/DBIx/Class/MethodAttributes.pm line 166
# DBIx::Class::MethodAttributes::_attr_cache("DBIx::Class::Storage::DBI::ODBC::Firebird") called at lib/DBIx/Class/MethodAttributes.pm line 166
# DBIx::Class::MethodAttributes::_attr_cache("DBIx::Class::Storage::DBI::ODBC::Firebird") called at lib/DBIx/Class/MethodAttributes.pm line 154
# DBIx::Class::MethodAttributes::FETCH_CODE_ATTRIBUTES("DBIx::Class::Storage::DBI::ODBC::Firebird", CODE(0x42ac2b0)) called at /home/rabbit/perl5/perlbrew/perls/5.16.2/lib/5.16.2/x86_64-linux-thread-multi-ld/attributes.pm line 101
# attributes::get(CODE(0x42ac2b0)) called at lib/DBIx/Class/_Util.pm line 885
# eval {...} called at lib/DBIx/Class/_Util.pm line 885
# DBIx::Class::_Util::describe_class_methods("DBIx::Class::Storage::DBI::ODBC::Firebird") called at xt/extra/internals/namespaces_cleaned.t line 129
# Out of memory!
# Out of memory!
# Out of memory!
# ...
# Segmentation fault
#
# FIXME: AS THIS IS CLEARLY A LACK OF DEFENSE IN describe_class_methods :FIXME
# Sweeping it under the rug for now as this is an xt/ test,
# but someone *must* find what is going on eventually
# FIXME: AS THIS IS CLEARLY A LACK OF DEFENSE IN describe_class_methods :FIXME

( $_ =~ /(.+)/ )

This comment has been minimized.

Sign in to view

Copy link
@ribasushi

ribasushi Jul 14, 2016

Author Collaborator

I will not have time to investigate the above travesty. Reproduced as a minimum on 5.16.2 and 5.16.3, possibly affects others. If someone is super curious and has the time - change this line to a plain $_ (pass-through): the reproduce-command is in the comment (the memlimit bashism is there to save your workstation).
^^ @haarg @ilmari @kentfredric @ap

This comment has been minimized.

Sign in to view

Copy link
@haarg

haarg Jul 14, 2016

Contributor

Reduced:
https://gist.github.com/haarg/1d3f2059f3e3807f91a18e962c44f595

Calling mro::get_linear_isa with a tainted class can break maybe::next::method.

Affects 5.12 through 5.16.

This comment has been minimized.

Sign in to view

Copy link
@ribasushi

ribasushi Jul 14, 2016

Author Collaborator

@haarg jesus... Thanks a lot for digging into this. Is it only maybe::next::method or can it have wider implications on next::method and friends?

Did you manage to find a perldelta for this, or it was an accidental fix due to some other changes?

This comment has been minimized.

Sign in to view

Copy link
@haarg

haarg Jul 14, 2016

Contributor

I didn't find anything in perldelta.

The deep recursion only seems to be triggered when there isn't another method to call. next::method will also be affected, but that is less important because it would only trigger in cases where the code was already broken.

This comment has been minimized.

Sign in to view

Copy link
@haarg

haarg Jul 14, 2016

Contributor

next::can will return the current sub.

This comment has been minimized.

Sign in to view

Copy link
@haarg

haarg Jul 14, 2016

Contributor

Calling $class->isa(...) with a tainted class will break things just like mro::get_linear_isa($class).

This comment has been minimized.

Sign in to view

Copy link
@ribasushi

ribasushi Jul 16, 2016

Author Collaborator

@haarg actually it can even fail inexplicably on 5.8.9:

perl -T -MMRO::Compat -e '
  {
    package Foo;
    use mro "c3";
    sub bar { shift->maybe::next::method }
  }

  my $class = "Foo" . substr($ENV{PATH},0,0);
  $class->isa("Baz");
  $class->bar
'
next::method/next::can/maybe::next::method cannot find enclosing method at /home/rabbit/perl5/perlbrew/perls/5.8.9/lib/site_perl/5.8.9/x86_64-linux-thread-multi/Class/C3/XS.pm line 66.

This comment has been minimized.

Sign in to view

Copy link
@ribasushi

ribasushi Jul 16, 2016

Author Collaborator

Went ahead and inserted a check at a semi-strategic spot, should be enough to prevent this from escaping: 5f0174dc9#diff-c13797cc2e5864c4a1d6a92ba65871b6R762

This comment has been minimized.

Sign in to view

Copy link
@haarg

haarg Jul 16, 2016

Contributor

I should have clarified. maybe::next::method in a $class->method call will always fail if $class is tainted. But it just dies, rather than infinitely recursing.

} grep {
my ($mod) = $_ =~ /(.+)/;

# not all modules are loadable at all times
Expand Down Expand Up @@ -115,10 +122,13 @@ for my $mod (@modules) {
SKIP: {
skip "$mod exempt from namespace checks",1 if $skip_idx->{$mod};

my %all_method_like = (map
{ %{stash_for($_)->get_all_symbols('CODE')} }
(reverse @{mro::get_linear_isa($mod)})
);
my %all_method_like =
map
{ $_->[0]{name} => $mod->can( $_->[0]{name} ) }
grep
{ $_->[0]{via_class} ne 'UNIVERSAL' }
values %{ describe_class_methods($mod)->{methods} }
;

my %parents = map { $_ => 1 } @{mro::get_linear_isa($mod)};

Expand Down

0 comments on commit b090048

Please sign in to comment.