0) 'Raw' JAPH without any fluff
eval((eval(join'',join'',map{unpack'C/(C.*/X/xa@)'}split/\n/,<<'MAGIC'
"BC8D%5/.31420-A69=(#:*$+<@;?)&',>7""$''((*,,;<=>AADTaaabchijkmnopsu{"
">DC95'A<?36;(%B&-#4*.=@8)$2+/0,17:$$''((())),,,1?_aacccdehknoppruuv{"
"?'=@:(#8)721*3%&CA><;B./-$9506+,D4$$''(()))),//046:;[]^__diloprrst}}"
MAGIC
))->(
<<'MORE MAGIC'
$SPW&VTV!P$SSVUWTW!PVRYT%VTWUVRW%VQV#
VSW!S!SSUVWRUUTQTTT&T%T#TYUXR#UUW%VTV
UVVV#RPSYR"SPRUW%VTVUVVV$SSWUWRV"WPWR
WYV%VTWTR&U"UPS$U"SPRUW%VTVUVVV"S$W"S
MORE MAGIC
));
undef->("Just another Perl hacker\n");
1) Initial phase
This is the whole
raison d'être of this JAPH. There is just something deliciously perverse about assigning a recursive subref to undef.
(Though not as perverse as tie'ing undef mind you...)
&Internals::SvREADONLY(\undef,0); undef=sub{print$_[0]; undef;};
my $h = undef;
$h->("Just another Perl hacker\n");
2) Add to variable for eval
(POD is there to help us later on in the final obfuscation step; It makes the first character a '$')
my $string = q|=pod
=cut
&Internals::SvREADONLY(\undef,0); undef=sub{print$_[0]; undef;};|;
eval $string;
my $h = undef;
$h->("Just another Perl hacker\n");
3) Convert string to hex (low nybble first), then xor 64, then uppercase
(This will help us later on in the final obfuscation step; It allows us to use lowercase letters as free text)
my $string = q|=pod
=cut
&Internals::SvREADONLY(\undef,0); undef=sub{print$_[0]; undef;};|;
$string = unpack "h*", $string;
# $string is d307f646a0d3365747a06294e6475627e616c637a3a3356725541444f
+4e4c49582c557e6465666c20392b30257e6465666d3375726b7072796e64742f5b503
+d5b30257e6465666b3d7b3
$string = join('', map{ uc chr( ord($_) ^ 64 ) } split(//, $string));
# $string is $SPW&VTV!P$SSVUWTW!PVRYT%VTWUVRW%VQV#VSW!S!SSUVWRUUTQTTT&
+T%T#TYUXR#UUW%VTVUVVV#RPSYR"SPRUW%VTVUVVV$SSWUWRV"WPWRWYV%VTWTR&U"UPS
+$U"SPRUW%VTVUVVV"S$W"S
4) Get a list of all the characters to xor with vec
(If you are not familiar with vec, this will create a bit string with the bits at the ordinal position of each character set to '1')
no warnings 'qw'; # shut up Perl... I'm a big boy now!
my $chars = '';
vec($chars, ord $_, 1) = 1 for qw/! " # $ % & P Q R S T U V W X Y/;
# $chars is \x00 \x00 \x00 \x00 \x7e \x00 \x00 \x00 \x00 \x00 \xff \x0
+3
$chars = pack 'u', $chars;
# $chars is ,`````'X``````/\#
5) Build a sub to remove extra characters
(If a character is on the vec list, it is xor'd by 64 to turn it into a hex digit for pack. Otherwise it is dropped)
my $sub = sub{ pack "h*", join('', map { vec(unpack('u',",`````'X`````
+`/\\#"), ord $_, 1) ? chr(ord $_ ^ 64) : '';} split //,$_[0]); };
6) Put everything together
my $sub = sub{ pack "h*", join('', map { vec(unpack('u',",`````'X`````
+`/\\#"), ord $_, 1) ? chr(ord $_ ^ 64) : '';} split //,$_[0]); };
my $string = <<'STRING';
$SPW&VTV!P$SSVUWTW!PVRYT%VTWUVRW%VQV#
VSW!S!SSUVWRUUTQTTT&T%T#TYUXR#UUW%VTV
UVVV#RPSYR"SPRUW%VTVUVVV$SSWUWRV"WPWR
WYV%VTWTR&U"UPS$U"SPRUW%VTVUVVV"S$W"S
STRING
my $eval = $sub->($string);
# $eval is =pod\n=cut\n&Internals::SvREADONLY(\undef,0); undef=sub{pri
+nt$_[0]; undef;};
eval $eval;
my $h = undef;
$h->("Just another Perl hacker\n");
7) Shorten $sub to a string of 102 characters
(Must be a multiple of 34 so it will fit in Perlmonk's default 70 character length for code)
my $sub = q|sub{$a=<DATA>;pack("h*",join('',map{vec(unpack('u',$a),ord
+($_),1)?chr(ord($_)^64):''}split//,$_[0]))};|;
8) Split $sub into groups of 34 characters, ASCIIbetize them, and use unpack() to reorder them.
This bit is the lynchpin for the whole JAPH. It uses some poorly (IMHO) documented features of unpack that many people many not have run across.
It does the following:
- C/ = read in the first character, take its ordinal value, and repeat the following () group that many times
- C = read in the next character and store its ordinal value on the stack
- .* = store the absolute character offset from the start of the string on the stack
- /X = pop the absolute character offset off the stack and back up that many characters
- /x = pop the ordinal value off the stack and advance that many characters in the string
- a@1 = read in a character into unpack and then return to the location where the () group started
- Wash, rinse, repeat...
$sub was split into groups of 34 characters so we could have 1 character for the repetition count + 34 characters for offsets + 34 characters of code = 69 total characters. Just under Perlmonk's 70 character code limit.
my $sub;
$sub .= join'',unpack'C/(C.*/X/xa@1)',q`"BC8D%5/.31420-A69=(#:*$+<@;?)
+&',>7""$''((*,,;<=>AADTaaabchijkmnopsu{`;
$sub .= join'',unpack'C/(C.*/X/xa@1)',q`">DC95'A<?36;(%B&-#4*.=@8)$2+/
+0,17:$$''((())),,,1?_aacccdehknoppruuv{`;
$sub .= join'',unpack'C/(C.*/X/xa@1)',q`"?'=@:(#8)721*3%&CA><;B./-$950
+6+,D4$$''(()))),//046:;[]^__diloprrst}}`;
my $string = <<'STRING';
$SPW&VTV!P$SSVUWTW!PVRYT%VTWUVRW%VQV#
VSW!S!SSUVWRUUTQTTT&T%T#TYUXR#UUW%VTV
UVVV#RPSYR"SPRUW%VTVUVVV$SSWUWRV"WPWR
WYV%VTWTR&U"UPS$U"SPRUW%VTVUVVV"S$W"S
STRING
my $eval = (eval $sub)->($string);
# $eval is &Internals::SvREADONLY(\undef,0); undef=sub{print$_[0]; und
+ef;};
eval $eval;
my $h = undef;
$h->("Just another Perl hacker\n");
__DATA__
,`````'X``````/\#
9) Condense $string and $sub.
eval (( eval pack "A*", join '', map { unpack 'C/(C.*/X/xa@1)' }
split /\n/, <<'SUB'
"BC8D%5/.31420-A69=(#:*$+<@;?)&',>7""$''((*,,;<=>AADTaaabchijkmnopsu{
">DC95'A<?36;(%B&-#4*.=@8)$2+/0,17:$$''((())),,,1?_aacccdehknoppruuv{
"?'=@:(#8)721*3%&CA><;B./-$9506+,D4$$''(()))),//046:;[]^__diloprrst}}
SUB
)->(
<<'STRING'
$SPW&VTV!P$SSVUWTW!PVRYT%VTWUVRW%VQV#
VSW!S!SSUVWRUUTQTTT&T%T#TYUXR#UUW%VTV
UVVV#RPSYR"SPRUW%VTVUVVV$SSWUWRV"WPWR
WYV%VTWTR&U"UPS$U"SPRUW%VTVUVVV"S$W"S
STRING
));
my $h = undef;
$h->("Just another Perl hacker\n");
__DATA__
,`````'X``````/\#
10) Fun and obfuscation
The fun bit. What we had previously may be decent, or even good, but it certainly was not
interresting. Let's give the JAPH some pretty formatting and make it look like Cthulhu, restrain ourselves to a 70 line length. Toss in a few quotes from
Wizard of Oz,
Inferno,
Event Horizon,
Schwa World operations Manual, and
Smashing Pumpkins. Sprinkle with a few popular culture memes and garnish with an easter egg, inside of the data, inside of the garbage.
#!/usr/bin/perl
{{{{THE:{{{{END:{{{{IS:{{{{THE:{{{BEGINNING:{{{{IS:{{{{THE:{{{{END{{{{
no strict; no warnings;# Where we're going, we won't need eyes to see.
undef->('J')->('u')
->('s')->('t')
->(' ')->('a')
->('n')->('o')
->('t')->('h')
->('e')->('r')
->(' ')->('P')
->('e')->('r')
->('l')->(' ')
->('h')->('a')
->('c')->('k')
->('e')->('r')
->((qq(\n)));# ALONE CANNOT YOU IT RESIST
;};};};};};};};};};};};};};};};};};};};};};};};};};};};};};};};};};};}
use strict;use warnings FATAL=>'all';use utf8;use 5.014;# It begins...
eval((eval(join'',join'',map{unpack'C/(C.*/X/xa@)'}split/\n/,<<'MAGIC'
"BC8D%5/.31420-A69=(#:*$+<@;?)&',>7""$''((*,,;<=>AADTaaabchijkmnopsu{"
">DC95'A<?36;(%B&-#4*.=@8)$2+/0,17:$$''((())),,,1?_aacccdehknoppruuv{"
"?'=@:(#8)721*3%&CA><;B./-$9506+,D4$$''(()))),//046:;[]^__diloprrst}}"
MAGIC
))->(# LASCIATE OGNI SPERANZA VOI CH'ENTRATE. LIBERATE TUTAME EX JAPH!
<<'MORE MAGIC'
$_='open(necromicon)and(seek(undef,undef))
((4SO)EPL(M)(6)(yv5((76aW((65(s&gxVH7Z(2f)
(2)ud)b))J06)r7m(6i)oO)L)(MF)T6(yv(E(6a(((
sgVxHZE(f)(!61P)u20d)b))J6)$76rm9(i7)So66(
52O07))L9)6(FS75M)2(07((y5)7V0)v2((UCa(((W
sg0TAxH4Z(fE)udW)65b))J!P76)rm65(i)oO)7L)(
M)(22V)(yv0R67((a(6(F6(sEgxY6HZ(Ef)6(1)ud2
)Tb06))JC)rm(i )o6O)L)5%(VTW7 U4VM2)(y0v((a(
(sgxH7Z(f)(R)9 6WFud)%bV)J)rm (i7Q)o5VO2)06L
)#4(6FV7M)76E( y0vA((a((S(Wsg !4Ex6HZ5(Sf7)u
d)b6))6J)r!m(i )S57oSO)L)(M2U )2067(6yFv((6E
6aE6(VW((sgxH1 Z(f)ud2)b0)R7U 2)J7)56rm(E2iU
)o0TO)LQ)6(M)( y1v((a(7T(2(6s F7gxHZ(fT)u5Td
)b))&J6)rm(Ei) o64O)L)(M)20(6 T1)6(y%v(E6(Ta
((#(T((oh.god.how.did.this.get.here.i.am.not.good.with.computer)4g2)(Y
xUH)Z(0f6)ud4)b)6)5J)rm7(i)oO)XL)3(M)(yR#Uv((6a((s57(gU27(x4HWZ))(2f0%
)(79)udVb6)F7T)50VJ)AUV4rE65m7(i)oO)L)V(MV6)#6(yv(572(a(2((sgxH0Z(f676
)(F6uEd6R))b)E)J)PrS6mY(i)oO)L)(M)(12yv((a((0(sgxHZ6RD"(f61)6(B6S)ud)b
52))J)rm(i)oOP)L0)(7M96)(F7)(yv((a(5((sRg(((x)H20)6ZU)(3W7f)(27)ud%V)9
b))JT)rVU2m(Ci0A)VV4oO)L)(VE$M)6(5)(yvS((aS7(((s6gx65HZ(f)W7(2)20u6d)b
U)76)J)rm(i)oWOR)FL6)(EM)6(yEv6((a(V((s"g(xH(W1Z))(20P7f)(W3)ud)b))RJ)
6rm(i1)WoO)L)( M7)Y(Vyv(9(2a(
((s0gx6HZ76%(f )uFdV)T6bF)6)J
4W)6rm(Ti279)o O)6L)(50RMA4&E
)U("6)U(y57v(P 6(Sa((sg$xUH65
Z(f)7u22d0)67b "6)FJ6)rEm(i)o
O)L)(M)(6E)(6y vS1((a(20(7((P
RUsg)xH4Z(6fW) 5u6d%VTC6)b)CV
U)J2)0r61m(i20 )o(VO)6VC)L6)(
M)(9Vyv((a(6(( sg5xH2Z(f"0)61
(u6(E6))d)bS)) J)rm(4i)$2Wo0O
6)"87L)(M5)(7) (27y)Sv4(a((sg xHZ(2f)07ud)b9
6)JF)rm750(iA) ).seek..into.. the.abyss..now
;..to.invoke.. .the.hivemind. .representing.
chaos;invoking ..the.feeling. of.chaos;with-
...out.order.. ...the.nezper- dian.hivemind.
of.chaos;zalgo ;he.who.waits. ..behind.the..
.wall;ZaLGo;'; undef:japh:{s( [^[:xdigit:]]|
[^([:upper:](( )[:digit:]))]) ()xgos;print((
(chr((hex))))) and(((select(( (undef),undef,
((((undef,)))) ,((0.01))))))) for(/(..)/g)};
MORE MAGIC
));
__DATA__ _____________________________________________________________
,`````'X``````/\#`Toto, I've a feeling we aren't in Kansas anymore...`
Have you tried running the code in 'MORE MAGIC' yet? It certainly won't let you down ;)
