Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses
 
PerlMonks  

Bear is driving?

by teamster_jr (Curate)
on Mar 29, 2006 at 18:17 UTC ( [id://540024]=obfuscated: print w/replies, xml ) Need Help??

But how is that possible?

This requires GD and will make a file called o.png in the directory from which it is run.
It is based on the "father of the impossible figure" (see what i did with the title now :) ) Oscar Reutersvard's most famous piece,
For those without GD you can see the output here

$_=q^use G;$i=M G::Image(FABL0,L0,L0);J l{$p=M G::C;$$_=ord(D-Lfor qw. +x y.;$p->addPt(($x+=D,($y+=D)while$#_;AfilledC($p,D}J d{E0,0,L,-HL,H-L,H +AB KFEL,HL,-H0,L,-L,HABL,0,0)}J a{d@_;E0,0,0,L,L,H0,-L,ABL,F}$_="]]?l!{!] +!? !!?0]?{N";s#(.)(.)#a"$1","$2";\n#g;/".+;/;$_.="d$&";eval;open Z,">o.pn +g" ;binmode Z;print ZApng^;for$r(qw.$i-> colorAllocate( Polygon shift) l@ +_, KK); GD 10, I sub 153, 20 new.){$l=chr 65+$c++;s#$l#$r#g}s#\n##g;eval
enjoy
al

UPDATE as per Pied's request, a deobfuscated version is available here, with an explanation of what's happening and the obfuscation process...
Update 2 changed link to output as old server is b0rked

Replies are listed 'Best First'.
Re: Bear is driving?
by wazoox (Prior) on May 12, 2006 at 20:38 UTC
    I haven't got any output either: Perl 5.8.7 on Debian GNU/Linux x86. The code runs, but has no effect... Any idea?
Re: Bear is driving?
by Pied (Monk) on Apr 03, 2006 at 00:25 UTC
    Impressive !!
    If you could put the clean one somewhere and tell us how you obfuscated this one...

    P!

    Are the monkeys gone yet?
      here is a completely cleaned up version, showing what is actually run:

      • Set up the canvas:
        use GD; $i = new GD::Image( 153, 153, ); $i->colorAllocate( 200, 200, 200 );
      • The functions:
        (by predefining them you don't need to use ())
        • l() is the actual drawing function - it takes and x and y coordinate, then an array of differences to make a polygon, finally the last argument is the colour it wants to be:
          sub l { $p = new GD::Polygon; $x=shift; $y=shift; $p->addPt( ( $x += shift ), ( $y += shift ) ) while $#_; $i->filledPolygon( $p, shift ); }
        • d() calls l() to draw the top (in grey) and right hand (in very dark) sides (this is required to be separate for reasons that will become clear later)
          It takes the starting x and y coordinates, and then has hardcoded the differences to get to other points to make these faces.
          sub d { l @_, 0, 0, 20, -10, 20, 10, -20, 10, $i->colorAllocate( 153, 15 +3, 153, ); l @_, 20, 10, 20, -10, 0, 20, -20, 10, $i->colorAllocate( 20, 0, + 0 ); }
        • a() calls d() then makes the final (front) face in a fairly nasty bluey colour. (the colours were chosen to maximise the string reuse (which will also be explained later).
          sub a { d @_; l @_, 0, 0, 0, 20, 20, 10, 0, -20, $i->colorAllocate( 20, 153, 153 +, ); }
      • and now the list of calls:
        a("73","73"); a("43","88"); a("13","103"); a("13","73"); a("13","43"); a("13","13"); a("43","28"); a("73","43"); a("103","58");
        These basically draw boxes in an order so they stack properly.
        d("73","73");
        This is added so that the top and right of the first box overlay all the others - creating the impossible perspective.
      • and finally draw it out:
        open FH, ">o.png"; binmode FH; print FH $i->png
      Now to save some space:
      The call list needs to be shortened. Since X and Y are 2 digit numbers they can be turned into characters, so by changing the part of a() where they are set:
      $$_ = ord(shift) - 20 for qw.x y.;
      we can then call them like this:
      a"]","]"; a"?","l"; a"!","{"; a"!","]"; a"!","?"; a"!","!"; a"?","0"; a"]","?"; a"{","N"; d"]","]"
      which then becomes this:
      $_ = "]]?l!{!]!?!!?0]?{N"; s#(.)(.)#a"$1","$2";\n#g; /".+;/; $_ .= "d$&"; eval;
      ie take two chars out of the string, and replace them with a"$1","$2";, then match the first call and use it to call d();

      eval will run the calls, drawing the boxes.

      To obfuscate, and save space i then did a form of huffman encoding, where repeated strings are replaced with a single letter, to do this the bulk of the program was but in $_, (using q^..^;) and then run through this:

      for$r(qw.$i-> colorAllocate( Polygon shift) l@_, KK); GD 10, I sub 153, 20 new.){$l=chr 65+$c++;s#$l#$r#g}
      for each of those strings in the main block, substitute the letter (starting at A (chr 65) ) with the corresponding string, so A is $i-> B is colorAllocat( etc.

      finally $_ (all the code) is eval'd

      Before posting i run it through my obfu formatter (which i call perlmess - the opposite of perltidy :) ), which simply reformats it as lines of 72 chars. (i also use it in development of these things as it tells me how many chars i'm at, and how many over 4 lines i am etc etc).

      HTH
      al

      Considered by teamster_jr: I was thinking of moving this to mediations as an explanation of obfuscation. is it worth it?
      Unconsidered by planetscape: keep votes prevailed (keep:15 edit:3 reap:0)

Re: Bear is driving?
by Nkuvu (Priest) on May 12, 2006 at 18:22 UTC

    Hmm. I'm getting no output. I checked the syntax with -wc and got a few warnings but "Syntax OK" at the end. No o.png file is created, nothing output to screen. And a 404 on the linked output.

    This is perl, v5.8.6 built for darwin-thread-multi-2level (that is, Perl on OS X). Any ideas?

      that's really odd - do you have GD installed? since it's wrapped in an eval without any error handling it will fail silently.

      if you add ||die $! to the end it will tell you what's wrong.(or replace the eval with a print, then run the output with warnings etc).
      oh and i changed the link to the output example.
      al

        I've added the "or die $!" part, and I have a "no such file or directory in popo.pl at line 6". Uh?

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: obfuscated [id://540024]
Approved by chargrill
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chilling in the Monastery: (4)
As of 2024-04-20 04:03 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found