We used B::Deparse in Item 7. Know which values are false and test them accordingly, but we didn’t say much about that module. The B namespace has many modules that do various nasty black magic things with the perl parse tree.
We showed the example of the default behavior behind while reading from the diamond operator:
% perl -MO=Deparse -e 'while( <STDIN> ) { print "$. $_" }'
When running under B::Deparse, perl compiles the code then writes it out again instead of running it. Since it decompiles the Perl code, it comes back as perl thinks it is, which might not be how you think it is.
while (defined($_ = <STDIN>)) {
print "$. $_";
}
-e syntax OK
If you run across a tricky one-liner, you can figure out what it is doing in the same way:
% perl -MO=Deparse -pi.old -e 's/foo/bar/g'
Now you see what perl wraps around that argument to -e:
BEGIN { $^I = ".old"; }
LINE: while (defined($_ = <ARGV>)) {
s/foo/bar/g;
}
continue {
print $_;
}
-e syntax OK
Don’t remember what the -F does and your cat accidently deleted your copy of perlrun?
% perl -MO=Deparse -naF: -e 'print @F[2,4,3]' /etc/passwd
LINE: while (defined($_ = <ARGV>)) {
our(@F) = split(/:/, $_, 0);
print @F[2, 4, 3];
}
-e syntax OK
You can do the same thing to ensure that the code that you think you are giving to perl is the same thing as what perl thinks it really is in the odd case where the syntax is blocking your view. By adding the -p switch to Deparse, you get parentheses Does exponentiation goes left-to-right or the other way around? Let B::Deparse tell you:
$ perl -MO=Deparse,-p -e 'print 4**$a**3 + 1' print(((4 ** ($a ** 3)) + 1)); -e syntax OK
B::Deparse works well for obfuscations, too. Here’s a JAPH that uses only punctuation characters:
`$=`;$_=\%!;($_)=/(.)/;$==++$|;($.,$/,$,,$\,$",$;,$^,$#,$~,$*,$:,@%)=(
$!=~/(.)(.).(.)(.)(.)(.)..(.)(.)(.)..(.)......(.)/,$"),$=++;$.++;$.++;
$_++;$_++;($_,$\,$,)=($~.$"."$;$/$%[$?]$_$\$,$:$%[$?]",$"&$~,$#,);$,++
;$,++;$^|=$";`$_$\$,$/$:$;$~$*$%[$?]$.$~$*${#}$%[$?]$;$\$"$^$~$*.>&$=`
You can make it’s work a bit more apparent by letting B::Deparse reformat it for you (although Perl::Tidy (Item 111) can do a similar job):
`$=`; use Errno (); $_ = \%!; ($_) = /(.)/; $= = ++$|; ($., $/, $,, $\, $", $;, $^, $#, $~, $*, $:, @%) = ($! =~ /(.)(.).(.)(.)(.)(.)..(.)(.)(.)..(.)......(.)/, $"), ++$=; ++$.; ++$.; ++$_; ++$_; ($_, $\, $,) = ($~ . $" . "$;$/$%[$?]$_$\$,$:$%[$?]", $" & $~, $#); ++$,; ++$,; $^ |= $"; `$_$\$,$/$:$;$~$*$%[$?]$.$~$*$#$%[$?]$;$\$"$^$~$*.>&$=`; punct syntax OK
Or how about this camel JAPH? Can you tell how it does its work?
sub j(\$){($
P,$V)= @_;while($$P=~s:^
([()])::x){ $V+=('('eq$1)?-32:31
}$V+=ord( substr( $$P,0,1,""))-74} sub a{
my($I,$K,$ J,$L)=@_ ;$I=int($I*$M/$Z);$K=int(
$K*$M/$Z);$J=int($J*$M /$Z);$L=int($L*$M/$Z); $G=$
J-$I;$F=$L-$K;$E=(abs($ G)>=abs($F))?$G:$F;($E<0) and($
I,$K)=($J,$L);$E||=.01 ;for($i=0;$i<=abs$E;$i++ ){ $D->{$K
+int($i*$F/$E) }->{$I+int($i*$G/$E)}=1}}sub p{$D={};$
Z=$z||.01;map{ $H=$_;$I=$N=j$H;$K=$O=j$H;while($H){$q=ord
substr($H,0,1,"" );if(42==$q){$J=j$H;$L=j$H}else{$q-=43;$L =$q
%9;$J=($q-$L)/9;$L=$q-9*$J-4;$J-=4}$J+=$I;$L+=$K;a($I,$K,$J,$ L);
($I,$K)=($J,$L)}a($I,$K,$N,$O)}@_;my$T;map{$y=$_;map{ $T.=$D->{$y}
->{$_}?$\:' '}(-59..59);$T.="\n"}(-23..23);print"\e[H$T"}$w= eval{
require Win32::Console::ANSI};$b=$w?'1;7;':"";($j,$u,$s,$t,$a,$n,$o
,$h,$c,$k,$p,$e,$r,$l,$C)=split/}/,'Tw*JSK8IAg*PJ[*J@wR}*JR]*QJ[*J'.
'BA*JQK8I*JC}KUz]BAIJT]*QJ[R?-R[e]\RI'.'}Tn*JQ]wRAI*JDnR8QAU}wT8KT'.
']n*JEI*EJR*QJ]*JR*DJ@IQ[}*JSe*JD[n]*JPe*'.'JBI/KI}T8@?PcdnfgVCBRcP'.
'?ABKV]]}*JWe*JD[n]*JPe*JC?8B*JE};Vq*OJQ/IP['.'wQ}*JWeOe{n*EERk8;'.
'J*JC}/U*OJd[OI@*BJ*JXn*J>w]U}CWq*OJc8KJ?O[e]U/T*QJP?}*JSe*JCnTe'.
'QIAKJR}*JV]wRAI*J?}T]*RJcJI[\]3;U]Uq*PM[wV]W]WCT*DM*SJ'. 'ZP[Z'.
'PZa[\]UKVgogK9K*QJ[\]n[RI@*EH@IddR[Q[]T]T]T3o[dk*JE'. '[Z\U'.
'{T]*JPKTKK]*OJ[QIO[PIQIO[[gUKU\k*JE+J+J5R5AI*EJ00'. 'BCB*'.
'DMKKJIR[Q+*EJ0*EK';sub h{$\ = qw(% & @ x)[int rand
4];map{printf "\e[$b;%dm",int(rand 6)+101-60* ($w
||0);system( "cls")if$w ;($A,$S)= ($_[1], $
_[0]);($M, @,)= split '}';for( $z=256
;$z>0; $z -=$S){$S*= $A;p @,} sleep$_
[2];while ($_[3]&&($ z+=$ S) <=256){
p@,}}("". "32}7D$j" ."}AG". "$u}OG"
."$s}WG" ."$t","" ."24}(" ."IJ$a"
."}1G$n" ."}CO$o" ."}GG$t" ."}QC"
."$h}" ."^G$e" ."})IG" ."$r",
"32}?" ."H$p}FG$e}QG$r". "}ZC"
."$l", "28}(LC" ."" ."".
"$h}:" ."J$a}EG". "$c"
."}M" ."C$k}ZG". "$e"
."}" ."dG$r","18" ."}("
."D;" ."$C" )}{h(16 ,1,1,0
);h(8, .98,0,0 );h(16 ,1,1,1)
;h(8.0 ,0.98,0, 1); redo}###
#written 060204 by
#liverpole @@@@@@@
#@@@@@@@@@@@
It looks a little better after B::Deparse:
sub j (\$) {
($P, $V) = @_;
while ($$P =~ s/^
([()])//x) {
$V += '(' eq $1 ? -32 : 31;
}
$V += ord(substr $$P, 0, 1, '') - 74;
}
sub a {
my($I, $K, $J, $L) = @_;
$I = int $I * $M / $Z;
$K = int $K * $M / $Z;
$J = int $J * $M / $Z;
$L = int $L * $M / $Z;
$G = $J - $I;
$F = $L - $K;
$E = abs $G >= abs $F ? $G : $F;
($I, $K) = ($J, $L) if $E < 0;
$E ||= 0.01;
for ($i = 0; $i <= abs $E; ++$i) {
$$D{$K + int($i * $F / $E)}{$I + int($i * $G / $E)} = 1;
}
}
sub p {
$D = {};
$Z = $z || 0.01;
map {$H = $_;
$I = $N = j($H);
$K = $O = j($H);
while ($H) {
$q = ord substr($H, 0, 1, '');
if (42 == $q) {
$J = j($H);
$L = j($H);
}
else {
$q -= 43;
$L = $q % 9;
$J = ($q - $L) / 9;
$L = $q - 9 * $J - 4;
$J -= 4;
}
$J += $I;
$L += $K;
a $I, $K, $J, $L;
($I, $K) = ($J, $L);
}
a $I, $K, $N, $O;} @_;
my $T;
map {$y = $_;
map {$T .= $$D{$y}{$_} ? $\ : ' ';} -59..59;
$T .= "\n";} -23..23;
print "\e[H$T";
}
$w = eval {
do {
require Win32::Console::ANSI
}
};
$b = $w ? '1;7;' : '';
($j, $u, $s, $t, $a, $n, $o, $h, $c, $k, $p, $e, $r, $l, $C) = split(/}/, 'Tw*JSK8IAg*PJ[*J@wR}*JR]*QJ[*JBA*JQK8I*JC}KUz]BAIJT]*QJ[R?-R[e]\\RI}Tn*JQ]wRAI*JDnR8QAU}wT8KT]n*JEI*EJR*QJ]*JR*DJ@IQ[}*JSe*JD[n]*JPe*JBI/KI}T8@?PcdnfgVCBRcP?ABKV]]}*JWe*JD[n]*JPe*JC?8B*JE};Vq*OJQ/IP[wQ}*JWeOe{n*EERk8;J*JC}/U*OJd[OI@*BJ*JXn*J>w]U}CWq*OJc8KJ?O[e]U/T*QJP?}*JSe*JCnTeQIAKJR}*JV]wRAI*J?}T]*RJcJI[\\]3;U]Uq*PM[wV]W]WCT*DM*SJZP[ZPZa[\\]UKVgogK9K*QJ[\\]n[RI@*EH@IddR[Q[]T]T]T3o[dk*JE[Z\\U{T]*JPKTKK]*OJ[QIO[PIQIO[[gUKU\\k*JE+J+J5R5AI*EJ00BCB*DMKKJIR[Q+*EJ0*EK', 16);
sub h {
$\ = ('%', '&', '@', 'x')[int rand 4];
map {printf "\e[$b;%dm", int(rand 6) + 101 - 60 * ($w || 0);
system 'cls' if $w;
($A, $S) = ($_[1], $_[0]);
($M, @,) = split(/}/, $_, 0);
for ($z = 256; $z > 0; $z -= $S) {
$S *= $A;
p @,;
}
sleep $_[2];
while ($_[3] and ($z += $S) <= 256) {
p @,;
}} '' . "32}7D$j" . '}AG' . "$u}OG" . "$s}WG" . "$t", '24}(' . "IJ$a" . "}1G$n" . "}CO$o" . "}GG$t" . '}QC' . "$h}" . "^G$e" . '})IG' . "$r", '32}?' . "H$p}FG$e}QG$r" . '}ZC' . "$l", '28}(LC' . "$h}:" . "J$a}EG" . "$c" . '}M' . "C$k}ZG" . "$e" . '}' . "dG$r", '18}(D;' . "$C";
}
{
h 16, 1, 1, 0;
h 8, 0.98, 0, 0;
h 16, 1, 1, 1;
h 8, 0.98, 0, 1;
redo;
}
This is one of the reasons that Perl code obfuscators are a waste of time. If someone can run the code, they can get it back out.