Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Obscure

by JimE (Initiate)
on Oct 25, 2001 at 20:14 UTC ( #121483=sourcecode: print w/ replies, xml ) Need Help??

Category: Utility Scripts
Author/Contact Info Jim Eshelman jime@nova-sw.com
Description: While contrary to the spirit of Perl, the harsh realities of the world sometimes make it desireable for your code to be less than totally open. Although it gets discussed from time to time in various forums, I've never actually found a tool to do this, so I wrote a 'perl code obscurer' for my current need that might be of some use to others. Does not go as far as the encrypt/decrypt model proposed by some, just file munging and var renaming to produce a distributable file that the interpreter can run. Discourages tampering but won't stop a determined reverse engineerer. More details in the pod in the file...
=pod

=head1 Nova Software, Inc.      http://www.nova-sw.com 

=head2 Perl Code Obscurer (Obscure.pl)

    Strips comments, blank lines, and indentation from a perl source c
+ode file, and then 
    substitutes non-mnemonic names for variable and subroutine names. 
+Passes through pod 
    anywhere in the file verbatim, as well as anything following an '_
+_END__' or '__DATA__'
    literal. The output file is useable perl code and will run on the 
+perl 5.6 interpreter,
    but is more difficult for others to understand, follow and modify 
+than the input source.  
    
    Call with the pathnames of the input and output files in that orde
+r as arguments. 
    Writes the substitution totals and lists to a file named <output f
+ile>.sub and leaves an
    intermediate (pre-substitution file) <output file>.tmp in the same
+ directory as the output
    file. Provides a progressing line count on STDOUT during execution
+ and dies with a message
    if the list of substitute names is exhausted before the input file
+ is completely processed. 
    
    Limitations:
    -Comments must begin with '##' or '# '.  This condition is for sim
+plicity, and could be relaxed.
    -Sub names should not be dictionary words, to avoid substitution i
+nto text strings.
    -Labels and constants are not renamed.
    -Variables to be renamed must declared in 'my' statements. 
    -Does not rename any variable beginning with 'tmp' due to the auth
+or's custom of liberal 
     use of such names as local scratchpad variables in his code.  

    Copyright by Nova Software, Inc. 2001   All rights reserved.  
    Written and maintained by James Eshelman, Oct, 2001
    This program is free software; you can use, redistribute, and/or m
+odify it under the same 
    terms as Perl itself. 

=cut

use strict;
use v5.6.1;
my ($t,$i,$a,$b,$c);
my (@t1,%subs,%strs,%arys,%hshs);
my ($pod,$numnames);
my @names = qw(aa ab ac ad ae af ag ah ai aj ak al am an ao ap aq ar a
+s at au av aw ax ay az
               ba bb bc bd b1 bf bg bh bi bj bk bl bm bn bo bp bq br b
+s bt bu bv bw bx b2 bz
               ca cb cc cd ce cf cg ch ci cj ck cl cm cn co cp cq cr c
+s ct cu cv cw cx cy cz
               da db dc dd de df dg dh di dj dk dl dm dn d1 dp dq dr d
+s dt du dv dw dx dy dz
               ea eb ec ed ee ef eg eh ei ej ek el em en eo ep e1 er e
+s et eu ev ew ex ey ez
               fa fb fc fd fe ff fg fh fi fj fk fl fm fn fo fp fq fr f
+s ft fu fv fw fx fy fz
               ga gb gc gd g1 gf gg gh gi gj gk gl gm gn g2 gp gq gr g
+s g3 gu gv gw gx gy gz
               ha hb hc hd h1 hf hg hh h2 hj hk hl hm hn h3 hp hq hr h
+s ht hu hv hw hx hy hz
               ia ib ic i1 i2 i3 ig ih ii ij ik il im i4 i5 i6 iq ir i
+7 i8 iu iv iw ix iy iz
               ja jb jc jd je jf jg jh ji jj jk jl jm jn jo jp jq jr j
+s jt ju jv jw jx jy jz
               ka kb kc kd ke kf kg kh ki kj kk kl km kn ko kp kq kr k
+s kt ku kv kw kx ky kz
               la lb l1 ld l2 lf lg lh li lj lk ll lm ln l3 lp lq lr l
+s l4 lu lv lw lx ly lz
               ma mb mc md m1 mf mg mh mi mj mk m2 mm mn mo mp mq mr m
+s mt mu mv mw mx m3 mz);  
$numnames=$#names;               
open FH1, "<$ARGV[0]" or die "Can't open $ARGV[0] due to: $! \n";
open FH2, ">$ARGV[1].tmp" or die "Can't open $ARGV[1].tmp due to: $! \
+n";
open FH3, ">$ARGV[1].sub" or die "Can't open $ARGV[1].sub due to: $! \
+n";
print "\nNumber of names available = $numnames\n\nProgram lines proces
+sed:\n";               
print FH3 "\nNumber of names available = $numnames\n\nProgram lines pr
+ocessed = ";               
while (<FH1>) { 
    $i++;
    print "$i\r";
    /^__END__|^__DATA__/ and print(FH2 $_) and last;  # Disk writes ar
+e not checked for errors due to laziness!    
    /^=pod/ and $pod=1 and print(FH2 $_) and next;
    /^=cut/ and $pod=0 and print(FH2 $_) and  next;    
    $pod and print(FH2 $_) and next; 
    s/#\s.*|##.*//g;
    s/^\s*//;
    s/^\n//;
    print FH2 $_;
    if (/^sub\s+\w+\s+/) {
        @t1=split;
        $t1[1]=~/BEGIN/ or $subs{$t1[1]}=shift@names;
    }  
    if (/\s*my\s+/) {
        @t1=();
        @t1=split /,/,$';
        foreach $a (@t1) {   
            next if $a=~/\$tmp\w*/;
            next if $a=~'@tmp\w*';
            next if $a=~/%tmp\w*/;
            next if $a=~'@_';
            if ($a=~/\$\w+/) {
                $b=$&;
                $c=substr $b,1;
                $strs{$c} or $strs{$c}=shift@names;
            }
            if ($a=~/@\w+/)  {
                $b=$&;
                $c=substr $b,1;
                $arys{$c} or $arys{$c}=shift@names;
            }
            if ($a=~/%\w+/)  {
                $b=$&;
                $c=substr $b,1;
                $hshs{$c} or $hshs{$c}=shift@names;
            }
        }    
    } 
    @names or die "\n\n >>>>>>> OUT OF NAMES! <<<<<<<<\n\n";
}
while (<FH1>) {    $i++;    print "$i\r";    print FH2 $_}
print FH3 "$i\n";
close FH1;
close FH2;
open FH1, "<$ARGV[1].tmp" or die "Can't open $ARGV[1].tmp due to: $! \
+n";
open FH2, ">$ARGV[1]" or die "Can't open $ARGV[1] due to: $! \n";
print "\n\nIntermediate file lines:\n";
print FH3 "\n\nIntermediate file lines = ";
$i=0;
while (<FH1>) {
    $i++;
    print "$i\r";
    /^__END__|^__DATA__/ and print(FH2 $_) and last;
    /^=pod/ and $pod=1 and print(FH2 $_) and next;
    /^=cut/ and $pod=0 and print(FH2 $_) and  next;    
    $pod and print(FH2 $_) and next;    
    my $ln=$_;
    # Note: order of matching is chosen to minimize accidental matches
+ in sub-strings. 
    foreach $a (keys %hshs) {
        $b='%'.$a;
        $c='%'.$hshs{$a};
        $ln=~s/$b/$c/g;    
        $b='\$'.$a.'\{';
        $c='$'.$hshs{$a}.'{';
        $ln=~s/$b/$c/g;    
    }
    foreach $a (keys %arys) {
        $b='@'.$a;
        $c='@'.$arys{$a};
        $ln=~s/$b/$c/g;    
        $b='\$'.$a.'\[';
        $c='$'.$arys{$a}.'[';
        $ln=~s/$b/$c/g;    
    }  
    foreach $a (keys %strs) {
        $b='\$'.$a;
        $c='$'.$strs{$a};
        $ln=~s/$b(\W)/$c$1/g;    
    }
    foreach $a (keys %subs) {
        $c=$subs{$a};
        $ln=~s/$a/$c/g;
    }
    print FH2 $ln;
}
while (<FH1>) { $i++;    print "$i\r";    print FH2 $_}
print FH3 "$i\n";
close FH1;
close FH2;
$t=$numnames-$#names;
print "\n\nNumber of names used = $t\n"; 
print FH3 "\n\nNumber of names used = $t\n"; 
print "\nWriting the symbol substitution lists in $ARGV[1].sub...\n";
print FH3 "\n\nsubs\n\n";
foreach (keys(%subs)) {    print FH3 $_,"\t",$subs{$_},"\n";}
print FH3 "\nstrings\n\n";
foreach (keys(%strs)) {    print FH3 '$',$_,"\t",'$',$strs{$_},"\n";}
print FH3 "\narrays\n\n";
foreach (keys(%arys)) {    print FH3 '@',$_,"\t",'@',$arys{$_},"\n";}
print FH3 "\nhashes\n\n";
foreach (keys(%hshs)) {    print FH3 '%',$_,"\t",'%',$hshs{$_},"\n";}
close FH3;
__END__


Comment on Obscure
Download Code
Re: Obscure
by JimE (Initiate) on Oct 25, 2001 at 20:40 UTC
    There, that looks a little more normal, now. I gues I'm still a novitiate with a lot to learn here!
Re: Obscure
by $code or die (Deacon) on Oct 25, 2001 at 21:28 UTC
    It's a bit hard to follow what you're code is doing here. Did you run it through obscure.pl before you posted? I ask because it's difficult to follow with all your short variable names.

    However, I am assuming that you didn't run the code through obscure.pl before posting. Because if you had, it wouldn't compile.

    An oft heard comment in the perl community is "Only perl can parse Perl". Your code will break a lot of scripts (and it does indeed break your own). The bit where you strip comments beginning with '##' will break a regex like $foo =~ s#bar## and a string like my $foo = ' bar ## more things here '; and a lot of other legitimate perl code. Removing comments is difficult in perl without breaking things.

    Your best bet if you want to do something like this is to use one of the Filter::* modules. Take a look at Filter::Simple which is designed to make writing source filters easy.

    Simon Flack ($code or die)
    $,=reverse'"ro_';s,$,\$,;s,$,lc ref sub{},e;$,
    =~y'_"' ';eval"die";print $_,lc substr$@,0,3;
      Thanks, Simon, for the feedback. I probably should have noted more clearly in the intro the kind of limitations with '##' that you note. Obscure certainly won't work in its present form for everyone or every script, including itself -- this is one script I haven't needed or deliberately intended to obscure. I see what you mean about the $t, $a, $b etc. -- these are probably a little to brief and do need improvement. On the other hand if you follow what, for me at least, are the relatively unrestrictive rules noted there you have a quick solution for code protection on new stuf you write and much that is already written. For instance, in not stripping a single '#' string unless followed by a space, html color attributes, many text contstructs, etc. that include it have worked out so far for me (100K lines.) (This rule also allows you to leave comments in the obscured script should you wish by simply leaving out a space after '#', as well as accepting the $# construct for array size, etc.) I did look at Filter but found it to be more complicated and time consuming than I needed for my coding style.
Re: Obscure
by monkfish (Pilgrim) on Oct 27, 2001 at 17:49 UTC
Re: Obscure
by demerphq (Chancellor) on Oct 29, 2001 at 16:24 UTC
    A minor criticism, but you are playing with fire by using variables named $a and $b. Both of these have special meaning to perl as they are used by the sort function. It is a very good idea to get into the habit of not using them at all, even if you do not use sort in the same code, as a later innocent addition of a sort command can result in very difficult to track down bugs.

    Yves / DeMerphq
    --
    Have you registered your Name Space?

      Thanks for the comment. I'll change them, and as Simon noted, generally improve variable naming for a little more readability.

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://121483]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others exploiting the Monastery: (5)
As of 2014-12-29 11:41 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (186 votes), past polls