What does this horribly ugly (yet somehow secretly beautiful) Perl code do?

1.1k views Asked by At

I found this code in a Powerpoint presentation about Perl scripting and this was on a page demonstrating how ugly Perl code can get if you really wanted to make it that way. The presentation says nothing about what this code does. Honestly I am just very curious to know... It has no compilation errors so it appears to be a valid Perl script, but I can't for the life of me figure out what it does.

Here is the script:

$_='while(read+STDIN,$_,2048){$a=29;$b=73;$c=142;$t=255;@t=map{$_%16or$t^=$c^=(
$m=(11,10,116,100,11,122,20,100)[$_/16%8])&110;$t^=(72,@z=(64,72,$a^=12*($_%16
-2?0:$m&17)),$b^=$_%64?12:0,@z)[$_%8]}(16..271);if((@a=unx"C*",$_)[20]&48){$h
=5;$_=unxb24,join"",@b=map{xB8,unxb8,chr($_^$a[--$h+84])}@ARGV;s/...$/1$&/;$
d=unxV,xb25,$_;$e=256|(ord$b[4])<<9|ord$b[3];$d=$d>>8^($f=$t&($d>>12^$d>>4^
$d^$d/8))<<17,$e=$e>>8^($t&($g=($q=$e>>14&7^$e)^$q*8^$q<<6))<<9,$_=$t[$_]^
(($h>>=8)+=$f+(~$g&$t))for@a[128..$#a]}print+x"C*",@a}';s/x/pack+/g;eval

I made a few attempts at reformatting it to try and make some sense of it, but I think it would take a true Perl guru to sort this one out...

Reformatted code:

$_ = 'while(read+STDIN, $_, 2048) {
    $a = 29;
    $b = 73;
    $c = 142;
    $t = 255;

    @t = map {
        $_%16 or $t ^= $c ^= ($m = (11, 10, 116, 100, 11, 122, 20, 100) [$_/16%8])&110;
        $t ^= (72, @z = (64, 72, $a ^= 12*($_%16 - 2 ? 0 : $m & 17)), $b ^= $_%64 ? 12: 0, @z) [$_%8]
    } (16..271);

    if ((@a = unx"C*", $_) [20]&48) {
        $h=5;

        $_ = unxb24, join "", @b = map {
            xB8, unxb8, chr ($_^$a [--$h + 84])
        } @ARGV;

        s/...$/1$&/;
        $d = unxV, xb25, $_;
        $e = 256 | (ord $b[4]) << 9 | ord $b[3];
        $d = $d
            >> 8^($f = $t&($d >> 12^$d >> 4^$d^$d/8))
            << 17, $e = $e >> 8^($t&($g = ($q = $e >> 14&7^$e)^$q*8^$q << 6))
            << 9, $_ = $t[$_]^(($h >>= 8) += $f + (~$g&$t)) for @a[128..$#a]
    }

    print+x"C*",@a
}';

s/x/pack+/g;
eval

When you run the code it seems to just continuously accept user input. I haven't been able to figure out how to make it do anything else or whether it even can do anything else.

The print statement near the end leads me to believe that there is some way to get it to a point where it will print an output though.

Also please don't tell me to migrate this to the codegolf website... Questions about how code functions are considered off topic for the codegolf site and are told to be redirected to StackOverflow.

1

There are 1 answers

5
ikegami On BEST ANSWER

Passing the code to Google returns this page that explains

qrpff is a Perl script created by Keith Winstein and Marc Horowitz of the MIT SIPB. It performs DeCSS in six or seven lines. The name itself is an encoding of "decss" in rot-13.

See also qrpff explained.