Beefy Boxes and Bandwidth Generously Provided by pair Networks
Think about Loose Coupling

Yet another structured obfuscation

by gmax (Abbot)
on Apr 09, 2002 at 12:25 UTC ( #157703=obfuscated: print w/replies, xml ) Need Help??

Narrative of how obfun! was created.
WARNING! Spoiler ahead. If you'd rather figure it out by yourself, read no more.

First stage. The original script

It all started with a coding exercise. I saw the hangman script in the Perl Power Tools package, and I wanted to code a better version. I especially disliked the print_noose() function, which is extremely naive. So I coded the program from scratch, just to demonstrate to myself that I could do it better, and the result is this one.
#!/usr/bin/perl -w use strict; my $file = shift; my $minlen = shift || 3; my @picture = ( ' +--+', ' |', ' |', ' |', ' |', '-----+'); my @cp =( # create picture [1,2,'O'], [2,2,'|'], [2,1,'/'], [2,3,'\\'], [3,1,'/'], [3,3,'\\']); my @wcp=( # winner create picture [2,1,'\\'], [2,2,'O'], [2,3,'/'], [3,2,'|'], [4,1,'/'], [4,3,'\\']); my ($errors, $word, $guess, $msg, $A) = (0,'','','','a'); my %letters = (); my %wordletters=(); my %garbled=map{$_,$A++} split //,'ifcseujmtaqybnzdwgvokxphlr'; { local $/=undef; my $words ; if (defined $file) { open FILE, "< $file" or die "file not found $file\n"; $words = <FILE>; close FILE; } else { $words = <DATA>; } srand(); $words =~ s/\n/ /g; my @ww = grep {length($_) >= $minlen} split / /, $words; my $count = scalar @ww; $word = lc($ww[rand ($count) -1]); $word = join '',map{$garbled{$_}}split //,$word unless $file; $guess = '-' x length($word); $count =0; for (split //,$word){push @{$wordletters{$_}},$count++}; } while (1) { # loops forever. Ends if win or lost draw($errors); if ($errors > 5) { print "YOU LOST ($word)\n"; exit } print $guess,"\n"; print 'used: <', keys %letters,">\n"; print "guess: "; my $x; chomp($x = <>); $x = lc($1) if $x=~/(\w)/; if ($x !~ /^\w$/) { $msg = "INVALID INPUT $x"; } elsif ($letters{$x}) { $msg = "ALREADY PLAYED: $x"; } elsif ($wordletters{$x}) { for (@{ $wordletters{$x}} ) { substr($guess, $_,1) = $x; } unless ($guess =~ /-/) { @cp=@wcp; $msg = "YOU WON! ($guess)"; draw(6); exit; } } else { $errors++ } $letters{$x}++; } sub draw { my $level = shift; my @pic = @picture; for my $j (1..$level) { substr($pic[$cp[$j-1][0]],$cp[$j-1][1],1) = $cp[$j-1][2]; } system ('clear') if $^O =~ /linux/; # add the following if you like it # system ('cls') if lc($^O) =~ /win/; print join $/,@pic,$/; if ($msg) { print "$msg$/"; $msg =""; } } # DATA contains the same words as in # from the 22nd line onwards __DATA__
This script can either take a word from its DATA (scrambled with a simple letter substitution), or from an external file. In addition to the original version features, it can print a different figure when you win.
So I said to myself "let's publish it to perlmonks.".
However, after a quick search, I found out that the Monastery has already its hangman code, plenty of them, actually, included golf ones.
What next? Well, let's obfuscate it!

Second stage. Shrinking

Therefore, I took my beautifully optimized code and started to shrink it, removing all unnecessary spaces, and encrypting the messages (A simple letter shifting).
@pc=qw(2+--+ 5| 5| 5| 5| -----+); s/(\d)/" " x $1/e for@pc; (@cp,@wcp)=((),()); $_="12O22|21/23\\31/33\\"; push@cp,[$1,$2,$3]while /(.)(.)(.)/g; $_="21\\22O23/32|41/43\\"; push@wcp,[$1,$2,$3]while /(.)(.)(.)/g; ($er,$wd,$gs,$msg,$A,%ls,%wl)=(0,"","","","a"); @xmg=("ZPV MPTU","vtfe:","hvftt: ","JOWBMJE JOQVU ", "BMSFBEZ QMBZFE:","ZPV XPO!"); %grbl=map{$_,$A++}split //,"ifcseujmtaqybnzdwgvokxphlr"; { local$/=undef; $_=<DATA> } srand(); s/\n/ /g; @ww=split / /,$_; $c=@ww; $wd=lc($ww[rand($c)-1]); $wd=join"",map{$grbl{$_}}split //,$wd; $gs="-" x length($wd); $c=0; push@{$wl{$_}},$c++for split //,$wd; @mg=map{tr/[b-z]/[a-y]/;tr/[B-Z]/[A-Y]/;$_}@xmg; while(1){ dw($er); if($er>5){print"$mg[0] ($wd)\n";exit} print$gs,"\n$mg[1] <",keys %ls,">\n$mg[2]"; chomp($x=<>); $x=lc($1)if$x=~/(\w)/; if($x!~/^\w$/){$msg="$mg[3] $x"} elsif($ls{$x}){$msg="$mg[4] $x"} elsif($wl{$x}) {for(@{$wl{$x}}){substr($gs,$_,1)=$x} unless($gs=~ /-/){@cp=@wcp;$msg="$mg[5] ($gs)"; dw(6);exit;}} else{$er++}$ls{$x}++} sub dw{ @p=@pc; for(1..$_[0]) {substr($p[$cp[$_-1][0]],$cp[$_-1][1],1)=$cp[$_-1][2]} system("clear")if $^O=~/linux/; print join $/,@p,$/; if($msg){print"$msg$/";$msg=""}} __DATA__

Third stage. Garbling

Even though this code is less clear than the previous one, it is easy to find out what it's doing.
So I wrote a quick garbling script, which creates a rather less clear version.
#!/usr/bin/perl -w use strict; my $count=0; my $text=''; while (<>) { last if /^__DATA__/; chomp; $text .= $_; } $text =~ s/\n/ /g; my @sorted = sort {$a->[1] cmp $b->[1]} map{[$count++,$_]} $text =~ /(.{20})/gs; my $index = join "", map {sprintf"%.2x",$_->[0]} @sorted; print substr($index,0,56),"\n"; print substr($index,56),"\n"; $count =0; for (@sorted) { print $_->[1]; if ($count++ > 1) { $count = 0; print "\n"; } } print "\n";
This scripts takes as its input (through STDIN) the previous one, with slightly less newlines than the one you see here (the final length must be divided by 20), and splits the code into chunks of 20 characters. Those chunks are stored into an array, where each element is an anonymous array of two items: the first one is one number, the same as the current substrcipt, and the second one is the code text .
By sorting this array alphabetically, the code is completely garbled. The keys to restore it are the first items, whose values are stored as a hex string (for compactness).
The result is what you can see in the first 21 lines of DATA in

Reading and executing the garbled code

Now my task is to get the garbled code, restoring it to its normal status and executing it without giving too many clues of what I was doing.
A non-obfuscated version of what needs to be done is:
while (<DATA>){ chop; if($.< 3) { # read the index (first 2 lines) $ndx .= $_; } else { # or the code text $text .= $_; } last if $. > 20; # now DATA contains only the words # that we need for the game } # rebuilds the index @index = map {hex $_} $ndx =~ /(..)/g; # gets the text, in chunks of 20 chars @code = $text =~ /(.{20})/g; $count=0; @original = map {$$_[1]} # gets the second element of the # sorted array sort{$$a[0] <=> $$b[0]} # sorts by the index map{[$index[$count++],$_]} # creates the array @code; # from the garbled text $_ = join '', @original; # now $_ has the working code eval;
There is too much information here. Something must be made less obvious to read.

The final script tries to hide all numerical literals in the code, taking advantage of the default value of some Perl globals. The $= variable's default value is 60. From that one, thanks to the help of some other dark globals and the scalar of qw(Nothing to hide), I got the other numbers that I needed to perform the rest of the task. The eval is hidden into a bogus substitution, which is also masqueraded as a sort of subscript.
$c=$=;$=/=$-=@_=qw(Nothing to hide);($m=$-)++;$c+=$-*$m; while (<DATA>){ s#(sub)$#\1 #; chop && $. < $- ? $x : $t .= $_; $. > $= && last; } $!=$%;$-=$=;($%=$=-=$=)++; $.=~s[2][join $\, map {$$_[$%]} sort{$$a[$!] <=> $$b[$|]} map{[(map{unpack("c*",pack((pack"c",$c)."*",$_))} $x =~ /(..)/g)[$=++],$_]} $t =~ /(.{$-})/g]seeme; __DATA__ 0f1623020c2127042e12071f19202f290a1510333236353109081a25 1d000d24050611171c1b0314300b2637132a2d2b2c28340e22181e01 ","BMSFBEZ QMBZFE:" / /,$_;$c=@ww;$wd=l <",keys %ls,">\n$mg " " x $1/e for@pc;(@"","","a");@xmg=("ZP"$mg[0] ($wd)\n";exi "$mg[3] $x"}elsif($l"12O22|21/23\\31/33\";dw(6);exit;}}else{ "ifcseujmtaqybnzdwgv$_="21\\22O23/32|41/$_}@xmg;while(1){dw( $_}}split //,$wd;$gs$er);if($er>5){print$er++}$ls{$x}++}sub $x"}elsif($wl{$x}){f)/g;($er,$wd,$gs,$ms);s/\n/ /g;@ww=split ,"ZPV XPO!");%grbl=m,1)=$cp[$_-1][2]}sys-1][0]],$cp[$_-1][1] /,@p,$/;if($msg){pri/linux/;print join $0]){substr($p[$cp[$_ 2,$3]while /(.)(.)(.43\\";push@wcp,[$1,$="-" x length($wd);$ =lc($1)if$x=~/(\w)/;@mg=map{tr/[b-z]/[a-@pc=qw(2+--+ 5| 5| 5 V MPTU","vtfe:","hvf[2]";chomp($x=<>);$x\";push@cp,[$1,$2,$3 ]while /(.)(.)(.)/g;ap{$_,$A++}split //,c($ww[rand($c)-1]);$ c++for split //,$wd;c=0;push@{$wl{$_}},$cp,@wcp)=((),());$_= def;$_=<DATA>}srand(dw{@p=@pc;for(1..$_[g,$A,%ls,%wl)=(0,"", if($x!~/^\w$/){$msg=nt"$msg$/";$msg=""}}okxphlr";{local$/=un or(@{$wl{$x}}){substp;$msg="$mg[5] ($gs)r($gs,$_,1)=$x}unles s($gs=~ /-/){@cp=@wcs{$x}){$msg="$mg[4] tem("clear")if $^O=~ tt: ","JOWBMJE JOQVUt}print$gs,"\n$mg[1]wd=join"",map{$grbl{ y]/;tr/[B-Z]/[A-Y]/;| 5| -----+);s/(\d)/
The published code looks simple at first glance. There is a DATA section, and the code is reading from DATA, after all. So the reader feels like the code is under control. But nothing is revealed unless he/she manages to figure out what the heck is going on among those stream of join, map, sort, map, map, unpack, pack, pack and two regexes.
Just one moment! What about that pack/unpack business?
Without going into too much details, I give you a hint. The following three lines are equivalent.
# map{unpack("c*",pack((pack"c",$c)."*",$_))} # map {hex $_} # map {unpack("c", pack(____, $_))} # fill in the blanks!
The ending "seeme" could have been a simple "ee", but I wanted it to kind of match with the initial "Nothing to hide".

Then, mission accomplished. Code obfuscated. Have fun!

update Want more of this same stuff? Try Structured obfuscation

 _  _ _  _  
(_|| | |(_|><

Replies are listed 'Best First'.
Re: Yet another structured obfuscation
by demerphq (Chancellor) on Apr 12, 2002 at 13:25 UTC
    Therefore, I took my beautifully optimized code and started to shrink it, removing all unnecessary spaces

    You might find perltidys --mangle function useful for this type of thing.

    Yves / DeMerphq
    Writing a good benchmark isnt as easy as it might look.

Re: Yet another structured obfuscation
by cecil36 (Pilgrim) on Apr 09, 2002 at 16:03 UTC
    This is a perfect example on how to hack Perl code. I might as well use it and try to obfuscate some of my stuff that I found/wrote. This might be fun to try on a UPS package tracking program I got from SourceForge.

    Update 4/10: Below is is my code after going through partial obfuscation.
    1210252b583e6b1575987127198a2917408d2260547f005251301e85 1d1a506c0849463b436839531b5973556e160591369a248c28848874323179818b3786 +040f262d5c933a3c34384a96907a764235898721772e3d5e2c4c95781c568265065a4 +f1197456a6f648e145b0d614d9923920e834b6d944e62803f445d7d0c010a2a414818 +201f72338f097c0b4757027e077b5f03637069132f6667 $LYNX="/usr/bin/l $WORKDIR="/home/A if (!(-e"$WORKDIR/$ if(!(-e"$WORKDIR/$O open(FILE,"$WORKDIR print "Enter the nu $new =~ s/^\s+//; "/pagemsg/PAGEMSG." $!\n";print FILE "M $OUTPUTOUT!\n"; unl (!($old eq $new)){o (FILE,">$WORKDIR/$L ="last.activity"; FILE "$new";close ( FILE "No Previous E email $MAILOUT.= $C send the status inf || die "Can't open !(-e"$WORKDIR")){mkd!\n";$foundit = 0; w"$F6 $F7 $F8 $F9 $F1 "; print FILE "\n";c#!/usr/bin/perl $Cou$F10,$F11)=split(' ' $F5,$F6,$F7,$F8,$F9,$LOGFILE")){open(FIL$OUTPUTIN=" $PagerCmd";}} open ($TRACK\\\&type1=1"; $URL="http://wwwapps $_;($F1,$F2,$F3,$F4,$new =~ s/\s+$//;($F'>',$CounterFile); p (LIST,"$WORKDIR/$OUT(example Arch)\n"; $) {s/^\s*$//g;print ); print "Enter the +$//; $packagestat, ">$WORKDIR/$OUTPUT ,$tmpnew,9999);$$LASTACTIVITY") || /$MAILOUT") || die "0 $F11"; last;}if (/4)=split(' ',$packag ;;chomp ($Counter);} ;close (FILE); unlin ;close(OUT); open(IN;unlink("logfile.txt;}chdir("$WORKDIR"); >$WORKDIR/$LOGFILE")ASTACTIVITY"); printBIN $PAGER";system " Can't open file $LASCould not open file:E");close (FILE);} o E,">$WORKDIR/$LOGFILENTS: Package ID $TER)){ $PagerCmd = "e FILE); open (FILE,">FILE, "$WORKDIR/$OUTFILE,">$WORKDIR/$LAS HEFILE>){$Counter=$_IN>;chomp($TRACK);LASTACTIVITY")){open LE,">$WORKDIR/$OUTPULE>;close(FILE); opeN") || die "Can't de OUT"); for (<INFILE>OUTPUT $_;} close(OUOUTPUTIN"); print OU PUTIN"); open(OUTPUTPUTOUT") || die "CouR/$OUTPUTOUT") || di RACK $status $new\n"RACK is/was $status SG:\n"; print FILE " STDIN>;chomp ($pagerT `lynx --dump $URL`TACTIVITY!\n"; print TACTIVITY") || die "TE=(localtime); if (TO: $pager $service TOUT");close (FILE);TPUT);close(INFILE);TPUTOUT") || die "Co UTPUTOUT")){open (FI\n"; $foundit = 0; w\n"; unlink("$WORKDI \n";print FILE "CONTacking.cgi?inquiry1=activity/i) {$foundi cho \"Check UPS Tracckagestatus=$_;last;close(THEFILE);$Coun die "Could not open dit == 1){$tmpnew = dministrator/perl"; e "Can't delete fileed by the recipient estatus =~ s/\s+$//; estatus, 9999);$statf($foundit == 1){$pafile $LOGFILE!\n";; file.txt";$MAILOUT =file: $!\n";$old=<FIg number for the pac hile(<LIST>){chomp($hile(<LIST>){chomp($ink("last.activity") ir("$WORKDIR", 0775)k("$WORKDIR/$OUTPUTIkage: "; $TRACK=<STD king$TRACK\" | $MAILld not open file: $!ld1,$Fld2,$Fld3,$Fld lete file $OUTPUTIN!line = $_);if ($founline = $_);if (/Stat lose (FILE);if(($PAGmber of the pager tomessaging service us n(LIST,"$WORKDIR/$OUnfor great justice, nter the UPS trackin nterFile='counter.txnter\n$Counter"; clontry";close (FILE);} o to.\n"; $pager = <omp ($service); openounter;$LASTACTIVITY output.txt"; $DAp.txt"; $OUTPUTOUT="pen (FILE,">$WORKDIR pen(OUT,">$WORKDIR/$print FILE "$DATE $TrintOUTFILE "pagecou se are belong to us\se(OUTFILE);print "Eservice = <STDIN>;ch t = 1;}}close(LIST);t'; open(THEFILE,$Cotake off every 'ZIG' ter++; open(OUTFILE,to $new\nall your bauld not open file: $ unterFile); while(<Tus/){$foundit = 1;}ius="$Fld3 $Fld4"; if us=~s/^\s+//;$packagynx";$LOGFILE = "log} if (!(-e"$WORKDIR/ }} close(LIST);$old=~s/^\s+//;$old=~s/\s
    Looks like it's a little too obvious, especially with the "all your base" scattered throughout the code.

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: obfuscated [id://157703]
Approved by mrbbking
Front-paged by Amoe
[mz2255]: I'm trying to post a question to "seekers of perl wisdom" but always getting a permission denied when I want to submit. There are no links in my post...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (11)
As of 2017-10-19 15:17 GMT
Find Nodes?
    Voting Booth?
    My fridge is mostly full of:

    Results (255 votes). Check out past polls.