Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Bits & pieces

by bobf (Monsignor)
on Jul 12, 2005 at 07:08 UTC ( #474186=obfuscated: print w/ replies, xml ) Need Help??

This started as a test script while I was learning about bit operations, and it slowly evolved into an obfuscated JAPH. I know it exceeds the traditional "4 line rule", but I thought that it would be fun to limit the digits used to only 0 and 1, given the theme. It was not golfed in any way.

Enjoy!

$_=[[[[{},[]],{0111,'01110111',1000,'11100101'},[[]]],{0001,'01111110' ,0110,'00011010',0100,'011001000011111001111010',0010,'00000100',0011, '01010101000100000001111110100010101000000000101000110000010001001010' .'10100',0101,'011100001001010100000001'},[[]]]];%_=%{${${$_}[0]}[1]}; $s=eval{$O=0,$C=0,$t='This is my 100th PM post';sub{$O++,$C=@_?$C:eval pack('b*',vec(pack('b*',$_{1<<(1<<0<<1)*((1<<0+1<<0)+1<<0)}),$O-1,1<<0 )?$_{1<<0}:$_{1<<(1<<1<<1)-1}).$C.pack('c',vec(pack('b*',$_{1<<((1<<0) +(1<<1*1<<1)+1<<0)}),($O-1)%((1<<0*1<<1)+1<<0),1<<(1<<0+1<<0)+1)).pack ('b*',vec(pack('b*',$_{1<<((1<<0+1<<0)+(1<<1<<1))}),$O-1,1)?$_{1<<((1+ 1<<0)+1)}:$_{1<<0}).vec($t,$O-1,1<<(1<<1<<1)-(1<<0))};};;$o=pack('b*', $_{((1<<1)**(1<<1)-1)**(1<<1)});for(0..unpack('%b*',$o)-(1<<1)){$c=$_- (($_-$_%(1<<1<<1))/(1<<1<<0*1<<1)+($_%(1<<1+1<<0)?1:0));;$i=(vec($o,$c ,(1<<1<<0+1<<0))+(vec($o,$c+1,(1<<1<<1))<<(1<<1<<0+1))>>((1<<1<<1<<1>> 1)-$_%(1<<1<<1<<1>>1)-(1<<1<<0+1)*($_%(1<<1<<1>>1<<1)?0:1)));$i+=$i%(1 <<1)?-1:1 if((($_+1)%((1<<1+1<<1)+(1<<1)+(1<<1)))&&!(($_+1)%((1<<1)**( 1<<1)-1))||$_+1==(1<<(1<<1+1<<1>>1))+(((1<<1)+1)<<1));$T=vec(pack('C', $i),0,(1<<1<<1>>1<<1))+vec(pack('b*',$_{(1+((1<<1)**(1<<1))**((1<<1)** (1<<1)-1))}),$_,1)*(1<<(1<<(1<<1)))+(1<<((1<<1**1<<1)+1));;print pack( 'c',($T+=$T==(1<<((1<<1+1<<1>>1)+1))?0:(1<<(((1<<1+1<<1)>>1)+(1<<0*1<< 1))))-=$_%(1+(((1<<1+1<<1)>>1)+(1<<0*1<<1)<<1))==0?(1<<(((1<<1*1<<1<<1 )+(1<<1<<1>>1))>>1)):0);&$s}print pack('c',$s->(1<<0)^unpack('c',(pack ('b*',$_{(1<<1*1<<1*1<<1)*((1<<1)**(1<<0<<1)-1)**(1<<1<<1>>1<<0)}))));

bobf

Hint: the bit shifts are fun, but they aren't the main point of the obfuscation.

Tested on

  • perl 5.005_03 built for i386-linux (little endian)
  • perl 5.6.0 built for sun4-solaris (big endian)
  • perl 5.6.1 built for MSWin32-x86-multi-thread (little endian)
  • perl 5.8.0 built for i386-linux-thread-multi (little endian)
  • perl 5.8.3 built for i686-linux (little endian)
  • perl 5.8.4 built for i386-linux-thread-multi (little endian)

Comment on Bits & pieces
Download Code
Re: Bits & pieces
by jdalbec (Deacon) on Jul 16, 2005 at 03:18 UTC
    B::Deparse gets rid of the bit shifts, but it breaks the code by omitting the parentheses after not below. After reinstating the parentheses and running the code through Perl::Tidy it's still not very readable. I've inserted some comments inside and outside the code to keep track of what's going on. Comments generally refer to the statements preceding them.
    $_ = [ [ [ [ {}, [] ], { 73, '01110111', 1000, '11100101' }, [ [] ] ], { 1, '01111110', 72, '00011010', 64, '011001000011111001111010', 8, '00000100', 9, '010101010001000000011111101000101010000000001010001100000100010010101 +0100', 65, '011100001001010100000001' }, [ [] ] ] ]; (%_) = %{ ${ ${ $_; }[0]; }[1]; };
    Most of the structure of $_ is obfuscation. Let's start over with %_ since $_ is never used again except for the localized $_ in the for loop.
    undef $_; %_ = ( 1 => '01111110', # '~' 72 => '00011010', # 'X' 64 => '011001000011111001111010', # '&|^' # 012345678901234567890123 8 => '00000100', # ' ' 9 => '010101010001000000011111101000101010000000001010001100000100010010101 +0100', #012345678901234567890123456789012345678901234567890123456789012345678 +9012 # 1 2 3 4 5 6 + 7 65 => '011100001001010100000001' # 012345678901234567890123 );
    Some of these (little-endian) bitstrings are really bytestrings and I've commented them as such. I've also added column numbers below some of the strings.
    $s = eval { do { $O = 0, $C = 0, $t = 'This is my 100th PM post'; # 012345678901234567890123 sub { $O++, $C = @_ ? $C : eval # { do { my $k = pack( 'b*', vec( pack( 'b*', $_{64} ), $O - 1, 1 ) ? $_{1} : $_{8} + ) . $C . pack( 'c', vec( pack( 'b*', $_{64} ), ( $O - 1 ) % 3, +8 ) ) . pack( 'b*', vec( pack( 'b*', $_{64} ), $O - 1, 1 ) ? $_{8} : $_{1} + ) . vec( $t, $O - 1, 8 ); # print " $k"; eval $k; } } } } };
    This subroutine is essentially pure obfuscation. It does some fairly random calculations using the characters of $t and a fudge factor is added at the end to produce the desired output.
    $o = pack( 'b*', $_{9} ); foreach $_ ( 0 .. unpack( '%b*', $o ) - 2 ) { # 16 bit checksum = 25, - 2 = 23
    Now we come to the heart of it. It's rather convenient that a 16-bit checksum of $o comes out so close to the length.
    $c = $_ - ( ( $_ - $_ % 4 ) / 4 + ( $_ % 4 ? 1 : 0 ) ); # print $c; # 0 0 1 2 3 3 4 5 6 6 7 8 9 9 10 11 12 12 13 14 15 15 16 17 $i = vec( $o, $c, 4 ) + ( vec( $o, $c + 1, 4 ) << 4 ) >> 4 - $_ % 4 - + 4 * ( $_ % 4 ? 0 : 1 ); # >> 0 3 2 1 0 3 2 1 0 3 2 1 0 3 2 1 0 3 2 1 0 3 2 1 # print $i; # 170 21 34 4 128 16 62 47 69 8 21 2 0 0 20 98 12 1 8 17 82 10 21 2 # print $i % 16; # == vec( pack( 'C', $i ), 0, 4 ) # 10 5 2 4 0 0 14 15 5 8 5 2 0 0 4 2 12 1 8 1 2 10 5 + 2 # 0101 0100 0000 0111 1010 1010 0000 0010 0011 0001 0100 10 +10 # 1010 0010 0000 1111 0001 0100 0000 0100 1000 1000 0101 + 0100 # J u r t n o u h e r P d r l a h a b j e + r # * * * * * * *
    Heavy comments here. These two statements extract the low nybbles of the JAPH phrase from $o. The trick is that the nybbles are offset by only 3 bits so the 8's bit of each character is the 1's bit of the next character. Naturally, not all the 1's bits are correct, but surprisingly many are. Also, some of the higher-order bits in $i are set, but they get stripped off later.
    $i += $i % 2 ? -1 : 1 # $i ^= 1 if ( $_ + 1 ) % 12 and not(( $_ + 1 ) % 3) or $_ + 1 == 22; # print $i; # 170 21 35 4 128 17 62 47 68 8 21 2 0 0 21 98 12 0 8 17 83 11 21 2 # print $i % 16; # 10 5 3 4 0 1 14 15 4 8 5 2 0 0 5 2 12 0 8 1 3 11 5 2 # J u s t a n o t h e r P e r l h a c k e r
    Here we fix up the erroneous 1's bits.
    $T = vec( pack( 'C', $i ), 0, 4 ) + vec( pack( 'b*', $_{65} ), $_, 1 +) * 16 + 32; # print $T; # 42 53 51 52 32 33 46 47 52 40 37 50 32 48 37 50 44 32 40 33 35 43 37 + 50 # 0 1 1 1 0 0 0 0 1 0 0 1 0 1 0 1 0 0 0 0 0 0 0 + 1 # J u s t a n o t h e r P e r l h a c k e + r # * 1 2 3 4 5 6 7 8 9 10 11 12 * 1 2 3 4 5 6 7 8 9 + 10
    Now we extract the low nybbles from $i and the 16's bits from $_{65}, and set the 32's bits unconditionally.
    print pack( 'c', ( $T += $T == 32 ? 0 : 64 ) -= $_ % 13 == 0 ? 32 +: 0 );
    Now we set the 64's bit unless the character is a space and reset the 32's bit for the two capital letters and print the result.
    # &$s; # independent of rest of loop, unrolled } # print ' ', &$s for 0..23; # 00 14294967295 2105 38 44294967263 573 68 74294967263 87 +7 # 94 104294967291 1153 120 134294967295 14116 1520 164294967263 17 +112 # 1813 194294967282 20125 2116 224294967295 23116
    As I mentioned above the calls to &$s are essentially pure obfuscation. In the last statement below a fudge factor $_{72} is xored with the final result to get a comma.
    print pack( 'c', &$s(1) ^ unpack( 'c', pack( 'b*', $_{72} ) ) );

      Good job! Included below is an explanation of this JAPH which is a bit (ba-dum-bum) more verbose. Your analysis hit on the big points, but I wanted to fill in some of the more subtle reasoning.

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (6)
As of 2014-11-23 13:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My preferred Perl binaries come from:














    Results (132 votes), past polls