Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

Undefined JAPH

by ateague (Beadle)
on Aug 28, 2013 at 23:08 UTC ( #1051327=obfuscated: print w/ replies, xml ) Need Help??

It is simply amazing what Perl's undef can do if you just ask it nicely. I got mine to print JAPH.

UPDATE! Spoiler available!

#!/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...`

I do not believe anyone has used this technique before.
I do not believe anyone has used this technique before in a JAPH here on Perlmonks. Please let me know what you think.



Spoilers 'n bits...

Credit where credit is due:
gmax As Tom Lehrer one sang: One man deserves the credit, one man deserves the blame.... Gmax's Perl Monk's Dream and Structured Obfuscation provided the initial inspiration for this. (I especially love his "Code+Garbage" technique)
Loops and 7stud Their posts helped me grasp some of the lesser known features of pack
Tobyink and Juerd They both opend my eyes to the crazy possibilities afforded by SvREADONLY

With all that out of the way, let's begin...
Recommended listening (Breakfast Machine) :)

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 ;)

Comment on Undefined JAPH
Select or Download Code
Re: Undefined JAPH
by davido (Archbishop) on Aug 29, 2013 at 05:30 UTC

    It earned a ++ and my admiration. ;)


    Dave

Re: Undefined JAPH
by Grimy (Pilgrim) on Aug 29, 2013 at 08:37 UTC

    Okay, this is one of the most wonderful JAPH Iíve ever seen. The topmost layer is deliciously puzzling, interweaving garbage, data, code and various in-jokes. The second layer is brilliantly executedóI havenít finished studying yet. The innermost layer uses a clever hack in Perlís internals in a way I hadnít thought of.

    Kudos to you, sir.

      I am glad you like it. I'll post a step-by-step spoiler for this sometime soon. Hopefully it will provide an entertaining read.
      The topmost layer is deliciously puzzling, interweaving garbage, data, code and various in-jokes.
      Did you try running the code in 'MORE MAGIC' yet by itself? It certainly won't let you down ;)
Re: Undefined JAPH
by Juerd (Abbot) on Aug 29, 2013 at 15:14 UTC
    Great JAPH! Nice obfuscation, interesting layout, funny comments.
    I do not believe anyone has used this technique before.
    Sorry, I beat you to it and gave a lightning talk in 2006 at YAPC::Europe in Birmingham, titled "undef isn't", about how much more fun undef becomes once its SvREADONLY is false and you can start treating it like a variable. May I suggest tie? ;-)
      Sorry, I beat you to it and gave a lightning talk in 2006 at YAPC::Europe in Birmingham ...

      You are quite correct. In fact, your online slides helped spark the inspiration for this. Credit where credit is due. What I meant to say was "I do not believe anyone has used this technique before in a JAPH here on Perlmonks. :)

Re: Undefined JAPH
by sparkyichi (Deacon) on Aug 29, 2013 at 17:34 UTC
    LASCIATE OGNI SPERANZA VOI CH'ENTRATE. LIBERATE TUTAME EX JAPH!

    I Love it!

    Sparky
    FMTEYEWTK
Re: Undefined JAPH
by sotona (Acolyte) on Aug 31, 2013 at 16:30 UTC
    just a little typo at line 26
    $_='open(necromicon)and(seek(undef,undef))
    should be necronomicon :)

      This is the cheap, knockoff, grey-market version of the Necronomicon; almost as good, but a whole lot cheaper! ;)

      I was wondering how long it would take for someone to notice that. I had to drop a letter somewhere on that line due to space constraints.

        oh, I see. so cheaper is apparently better :)

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: obfuscated [id://1051327]
Approved by davido
Front-paged by kcott
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (11)
As of 2014-11-27 13:08 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (184 votes), past polls