1use strict;
2use warnings;
3use Test::More;
4
5BEGIN {
6    my @missing;
7    for (
8        [qw[ File::Basename dirname ]],
9        [qw[ File::Spec::Functions catfile catfile devnull ]],
10        [qw[ IPC::Run run ]],
11        [qw[ YAML Dump ]],
12        [qw[ File::Temp tempfile ]]
13        )
14    {
15        my ( $mod, @import ) = @$_;
16        eval "use $mod qw( @import )";
17        push @missing, $mod if $@;
18    }
19
20    if (@missing) {
21        plan( skip_all => "Missing modules @missing" );
22        exit 0;
23    }
24    else {
25        plan( tests => 5 * 5 + 3 * 5 );
26    }
27}
28
29my $test_dir = dirname($0);
30
31my @scripts = map catfile( $test_dir, "${_}_t" ),
32    qw(scalar array hash code glob);
33
34my $syntax_checker = catfile( $test_dir, 'syntax.pl' );
35
36my ( $tmp_fh, $tmp_nm ) = tempfile( UNLINK => 1 );
37for my $test (
38    {   cmd => [ [ $^X, $syntax_checker, 'HERE' ] ],
39        nm => 'basic syntax'
40    },
41    {   cmd => [ [ $^X, '-Mblib', '-MO=Deobfuscate', 'HERE' ] ],
42        nm => 'basic deobfuscation'
43    },
44    {   cmd => [ [ $^X, '-Mblib', '-MO=Deobfuscate,-y', 'HERE' ] ],
45        nm => 'yaml output'
46    },
47    {   cmd => [
48            [ $^X, '-Mblib', '-MO=Deobfuscate,-y', 'HERE' ],
49            '|',
50            [ $^X, '-000', '-MYAML', '-e', 'Load(scalar <STDIN>)' ]
51        ],
52        nm => 'yaml syntax'
53    },
54    {   cmd => [
55            [ $^X, '-Mblib', '-MO=Deobfuscate', 'HERE' ],
56            '|', [ $^X, $syntax_checker ]
57        ],
58        nm => 'deobfuscation syntax check'
59    },
60    )
61{
62
63    for my $script (@scripts) {
64
65        seek $tmp_fh, 0, 0;
66        truncate $tmp_fh, 0;
67
68        my @command = map {
69            ref()
70                ? [ map { /^HERE\z/ ? $script : $_ } @$_ ]
71                : $_
72        } @{ $test->{cmd} };
73
74        local ( $@, $? );
75
76        my $ok = run( @command, '2>&1', '>', $tmp_nm );
77        ok( $ok, $test->{nm} );
78        if ( not $ok ) {
79            local $/;
80            diag( \@command, scalar <$tmp_fh> );
81        }
82    }
83}
84
85my $canonizer = catfile( $test_dir, 'canon.pl' );
86for my $script (@scripts) {
87    my @normal = (
88        [ $^X, '-MO=Concise', $script ],
89        '|', [ $^X, $canonizer ],
90        '>', $tmp_nm
91    );
92    my @deob = (
93        [ $^X, '-Mblib', '-MO=Deobfuscate', $script ],
94        '|', [ $^X, '-MO=Concise' ],
95        '|', [ $^X, $canonizer ],
96        '>', $tmp_nm
97    );
98
99    seek $tmp_fh, 0, 0;
100    truncate $tmp_fh, 0;
101    ok( run(@normal), "Normal $script" );
102    my $normal = do {
103        local $/;
104        <$tmp_fh>;
105    };
106
107    seek $tmp_fh, 0, 0;
108    truncate $tmp_fh, 0;
109    ok( run(@deob), "Deobfuscate $script" );
110    my $deob = do {
111        local $/;
112        <$tmp_fh>;
113    };
114
115    is( "$normal", "$deob", "Comparing optrees: $script" );
116}
117