/ domm

I hack Perl for fun and
profit.

Follow me on twitter!
Atom Icom ... on Atom!
<<<<<<<<<<
07.11.2013: MOPfuscation explained

For the Austrian Perl Workshop 2013 T-Shirt I decided to try an obfuscation (again, after not having done any obfus for ages). I was inspired by the ancient APW 2004 T-Shirt that Nick wore on the planning meeting. (I'll post about that shirt another time..). But I wanted to try a few new and crazy things, so I decided to make an obfuscation based on p5-mop-redux, Stevans current attempt to bring Perl 6 greatness into Perl 5 (my words) or "the second attempt at building a MOP for Perl 5" (his words). If you don't know what MOP is, let-me-wikipedia-that-for-you

Anyway, here is the code in full-obfu, ASCII-art mode (as featured (nearly0) on the front side of the shirt as part of "APW 2013"):

# works with p5-mop-redux ce50586a
use mop;use 5.18.1;no strict 'refs';
class APW{method Austrian($m){map{($_=
$_->name)=~s;             ^..;;x;$_}$m->
attributes};                has $!hack =
'Salzburg ';                has $!learn=
'2. & 3.11.'                .' 2013';has
$!socialize=                q $@ncm.at$;
method Perl(                $m){sort+map
{$a=$_->name                ;eval"$a"}$m
->attributes}              ;42.;method
Workshop($m){grep{/^[APW]./}sort+map{
$_->name}$m->methods}};for(mop::meta
('APW')){$_->add_method(mop::method
->new(name=>$",
body=>sub{map
{say+join( $"
,$_[0]->$_($_
[1]))}reverse
$_[0]->$;($_[
1])}));42;$;=
q^########^^q
atLQHPKLSa;$_
->FINALIZE ->
new_instance#
->$"($_)};###

Quick, what does it print out?

I'll wait a bit until you've figured it out...

Still waiting.

The output of course is:

Austrian Perl Workshop
2. & 3.11. 2013 @ncm.at Salzburg
learn socialize hack

All of the stuff that's printed is available in clear text in the code, so this is not a lame data obfuscation, but a proper how-the-fuck-did-this-happen obfuscation.

To make things a bit clearer, here's the code as featured on the backside:

use mop; use 5.18.1; no strict 'refs'; # use p5-mop-redux ce50586af1d

class APW {
  has $!hack        =  'Salzburg';
  has $!learn       =  '2. & 3. 11 2013';
  has $!socialize   =  '@ncm.at';

  method Austrian ($m) {map{($_=$_->name)=~s;^..;;;$_}$m->attributes}
  method Perl     ($m) {sort+map{$a=$_->name;eval"$a"}$m->attributes}
  method Workshop ($m) {grep{/^[APW]./}sort+map{$_->name}$m->methods}
}

 for(mop::meta('APW')){$_->add_method(mop::method->new(name=>$",body
 =>sub{map{say+join($",$_[0]->$_($_[1]))}reverse$_[0]->$;($_[1])}));
 $;=q^########^^q atLQHPKLSa;$_->FINALIZE->new_instance->$"($_)};

Let's take a close look:

use mop; use 5.18.1; no strict 'refs'; # use p5-mop-redux ce50586af1d

Of course we use mop. (You'll probably want to get it from github. The code works with commit ce50586af1d, no idea if it works with more current versions. I installed a fresh Perl using perlbrew to test the code, and I'll blog about that later...)

If you're unfamiliar with p5-mop, you might want to read dams' excellent blog post p5-mop, a gentle introduction.

class APW {
  has $!hack        =  'Salzburg';
  has $!learn       =  '2. & 3. 11 2013';
  has $!socialize   =  '@ncm.at';

  method Austrian ($m) {map{($_=$_->name)=~s;^..;;;$_}$m->attributes}
  method Perl     ($m) {sort+map{$a=$_->name;eval"$a"}$m->attributes}
  method Workshop ($m) {grep{/^[APW]./}sort+map{$_->name}$m->methods}
}

Using class I define a new class called APW (which is short for Austrian Perl Workshop).

has defines attributes using something called twigils. I also assign default values to them.

method defines a method. Note that you can specify the parameter list of each method between the method name and the actual code. Also, there is no need to unshift $self, or do any parameter processing in your method. Yay!!!

So now let's look at the method bodies, which use a combination of metaprogramming and run-of-the-mill obfuscation.

method Austrian ($m) {map{($_=$_->name)=~s;^..;;;$_}$m->attributes}

The method gets passed one parameter, $m. For now you have to believe me that it's the metaobject representing the APW class. The code starts with map. In Perl 5 you have to read @map@s from right to left (not so in Perl 6), so we start at the right end:

$m->attributes calls the attributes method on the metaobject, which returns the list of all attributes defined in the class (just like in Moose). Inside the map, I do a classic get-value-replace-parts-and-store-result:

my ($new = $old) =~ s/foo/bar/;

Only here I get the name of the attribute ($_->name), run the regex s/^..// on it and store the result of the regex application in $_. The regex itself uses ; instead of / to mess things up a little. The replacement itself is simple: Take the first two characters (^..) and replace them with nothing. This is necessary because $attribute->name returns the whole twigil, eg $!hack, but only want to output hack. In the end of the map block I return $_ (i.e. hack).

So the method Austrian will return a list of nice attribute names ("hack", "learn", "socialize").

Let's look at the next method, Perl:

method Perl ($m) {sort+map{$a=$_->name;eval"$a"}$m->attributes}

It looks similar to Austrian because it maps over the list of attributes. But here I store the attribute name in $a (which does not need to be declared with my because of it's usage in sorting (together with $b) - very handy for obfus!).

eval $a will string-eval the attribute name, thus returning the attributes value, e.g. "Salzburg".

The plus-sign between sort and map is a no-op that's just ignored by Perl. Obfu tip: you can replace an awful lot of whitespace with + and it won't make a difference!

So Perl returns a sorted list of the values of all attributes of APW, i.e. "2. & 3.11. 2013", "@ncm.at","Salzburg".

method Workshop ($m) {grep{/^[APW]./}sort+map{$_->name}$m->methods}

This method is again a map/grep chain so we start at the right end, where I call methods to get a list of all methods defined in APW. Inside the map I get each methods name, which get passed to sort. The sorted list gets passed on to grep which filters out all methods besides those starting with either A, P or W.

So Workshop returns "Austrian", "Perl", "Workshop".

I think by now you'll start to understand how the output is generated. But to make sure, let's look at the final code block:

for(mop::meta('APW')){$_->add_method(mop::method->new(name=>$",body
 =>sub{map{say+join($",$_[0]->$_($_[1]))}reverse$_[0]->$;($_[1])}));
 $;=q^########^^q atLQHPKLSa;$_->FINALIZE->new_instance->$"($_)};

Lets unwrap that a bit:

for (mop::meta('APW')) {
    $_->add_method( mop::method->new(
        name => $",
        body => sub {
            map { say+join($",$_[0]->$_($_[1])) }
                reverse $_[0]->$;($_[1])
        }
    ));
    $;=q^########^^q atLQHPKLSa;
    $_->FINALIZE->new_instance->$"($_)
};

Here we have a for-loop iterating over just one item, mop::meta('APW'). This is basically a slightly convoluted way to put the meta object of APW into $_.

Next we call add_method on the meta object. add_method allows you to dynamically add a method to a class (and is in fact used internally by p5-mop when you set up method@s). The method needs a name, which shall be $"@. If you don't know what $" is, you can read about it in perldoc perlvar. It's value per default is " " (a space). So yes, we define a method name " ". (Which is not quite as crazy as the function called "\n" in Damian Conway's SelfGOL).

The methods body is again a map construct, so we start at the reverse. Here we call a method whose name is stored in $; (we'll come to that in a minute) on whatever object is in $_[0] with the value of $_[1] as its argument. Please keep this in your head for a bit, because we have to continue with the map.

Inside the map is a join, which joins something using $" (space, you remember?). And what does it join? Whatever the method whose name is stored in $_ returns when called on $_[0]. We still don't quite know what this is, so lets continue..

$;=q^########^^q atLQHPKLSa;

Here we see what's inside $; (i.e. the name of the method that's called by reverse). I'm using a stupid data obfuscation trick here, because I didn't want to have any of my output data included twice in the source code. You maybe can read the code better if we replace the funky quote operators with regular strings:

$;='########' ^ 'tLQHPKLS';

Not sure if you know that, but q can take a lot of special chars instead of just ( or /. And if you add a space after q you can also use any regular letter! So this q atLQHPKLSa is the same as this 'tLQHPKLS'. Besides the quoting, what's happening here is that we bitwise XOR the two strings '########' and 'tLQHPKLS' which coincidentally returns 'Workshop'.

So this: reverse $_[0]->$;($_[1]) is in fact: reverse $_[0]->Workshop($_[1])

The next and final line tells us what $_[0] and $_[1] are:

$_->FINALIZE->new_instance->$"($_)

$_ is still the APW meta object. I call FINALIZE on it to properly install the method (" ") I've created. new_instance creates a new instance, i.e. a new object of class APW. On this object we call $", passing in $_, i.e. the meta object.

Now we can better understand what's happening inside the dynamically generated methods body:

body => sub {
    my ($self, $meta) = @_;
    map { say join(" ", $self->$_($meta)) }
        reverse $self->Workshop($meta)
}

I call Workshop, which will return a list of all methods starting with A, P, or W. Then I call each of this methods on the object, which will return the list of method names (Austrian Perl Workshop), the values of the attributes (2. & 3.11. 2013 @ncm.at Salzburg) and finally the clean name of the attributes (socialize hack learn).

Add some join and say and we're done!

PS: At the APW2013 hackathon I ported to code to Perl 6 (with some help from Liz and Joanathan). I'll post the code soonish...

Footnotes:

0 With all the copy'n'pasting and ASCII-art-formatting I managed to send a quite broken version of the P to the t-shirt-printer. A whole line of Perl code is duplicated, resulting not only in a not-so-nice P shape, but also broken code. Well, those shirts will now be limited collector items :-)

Comments (via disqus)

03.11.2013: Austrian Perl Workshop 2013
11.10.2013: Austrian Perl Workshop 2013 - Call for everything
07.09.2013: OpenSource++ - How to contribute to a project without knowing a damn bit about it
04.09.2013: OpenSource++ - The other side
02.09.2013: OpenSource++
16.08.2013: Things I learned at YAPC::Europe 2013 in Kiev
30.05.2013: given & smartmatch in Perl 5.18
05.05.2013: 4 TPF Grant Proposals are waiting for some review
21.04.2013: Bread::Board is the right tool for this job
>>>>>>>>>>
an image named perl/2013_11_MOPfuscation_images/mopfuscation_1.jpg

an image named perl/2013_11_MOPfuscation_images/mopfuscation_2.jpg

an image named perl/2013_11_MOPfuscation_images/mopfuscation_3.jpg