Skip to content

Instantly share code, notes, and snippets.

@kentfredric
Created January 23, 2015 17:15
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save kentfredric/ce1df3e7e509e071b63d to your computer and use it in GitHub Desktop.
Save kentfredric/ce1df3e7e509e071b63d to your computer and use it in GitHub Desktop.
Abuse CPANM by hacking its library loading process to allow injecting arbitrary code.
#!/usr/bin/env perl
# FILENAME: unfatten.pl
# CREATED: 01/24/15 04:55:06 by Kent Fredric (kentnl) <kentfredric@gmail.com>
# ABSTRACT: Attempt to extract files from a codes fatpacked library.
use strict;
use 5.010001;
use warnings;
{
package Capture;
use Tie::Array;
our @ISA = ('Tie::Array');
sub TIEARRAY {
my ( $classname, %args ) = @_;
return bless {
original => $args{original},
storage => $args{storage},
}, $classname;
}
sub FETCH {
my ( $self, $index ) = @_;
return $self->{original}->[$index];
}
sub FETCHSIZE {
my ($self) = @_;
return scalar @{ $self->{original} };
}
sub UNSHIFT {
my ( $self, @list ) = @_;
push @{ $self->{storage} }, $_ for @list;
die "Capture done";
}
}
my $storage = [];
sub capture {
my $original = [@INC];
{
local @INC;
tie @INC, 'Capture', ( storage => $storage, original => $original );
local $@;
eval { require "/home/kent/perl5/perlbrew/bin/cpanm"; };
}
untie @INC;
@INC = @{$original};
}
use Scalar::Util qw(blessed);
capture();
for my $elem ( @{$storage} ) {
next unless ref $elem;
next unless blessed $elem;
my $class = blessed $elem;
my $orig = $class->can('INC');
my $new = sub {
return unless $_[1] =~ qr{\AApp/cpanminus};
print "Fetching $_[1]\n";
return $orig->(@_);
};
{
no strict 'refs';
no warnings 'redefine';
*{"${class}::INC"} = $new;
}
unshift @INC, $elem;
}
require App::cpanminus::script;
{
my $old = App::cpanminus::script->can('install_module');
my $stack = [];
sub pp_stack {
printf "\e[31m%s\e[0m", join qq[->\n], map { $_->[0] } @{$stack};
}
my $new = sub {
my ( $self, $module, $depth, $version ) = @_;
push @{$stack}, [ $module, $depth, $version ];
pp_stack;
my $exit = $self->$old( $module, $depth, $version );
pop @{$stack};
return $exit;
};
{
no strict 'refs';
no warnings 'redefine';
*{"App::cpanminus::script::install_module"} = $new;
}
}
unless (caller) {
my $app = App::cpanminus::script->new;
$app->parse_options(@ARGV);
exit $app->doit;
}
@dolmen
Copy link

dolmen commented Jan 26, 2015

Crazy stuff!

Check my fork, a bit less crazy ;)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment