Calling encrypted perl file with our require("file.pl")

Discussion in 'Perl Misc' started by Vijoy Varghese, Jul 9, 2005.

  1. Hello Group


    My manager wants me to encrypt/scramble the perl programs I created
    before delivering to client. I tried to convince him that a 'legal
    warning' will do the job, but he is not happy, and so is his boss.

    I searched the web, and found a program called 'Perl Coder'. What it
    does it, it will take the perl program as input and will create a new
    perl file which looks like '@#$#@fasd$#'. All i need to do was to
    change the Shebang line, and it was working fine.

    But its not the end of the story, my project is lying over 48 files
    called as 'require library_names.pl;'. There is only one executable
    perl code 'index.pl'.
    the structure is like this

    .../cgi-bin/index.pl (executable)

    /some/where/else/lib/library1.pl
    /some/where/else/lib/library2.pl
    /some/where/else/lib/one/library2_1.pl
    ..
    ..
    /some/where/else/lib/five/library4_3.pl


    I tried to encrypt each of the library files, and executed the
    'index.pl' file, but it was not working.

    Then I decided to find how 'Perl Coder' was encrypting/scrambling perl
    files. It's something like, they does some kind of encryption of the
    entire perl code, and store it in a variable like
    $AXJXSXOXHXJXGXJXYXJXGXDXRXYXZXXYXZDXFXGXBVXAXQX, then at the end, they
    use this code [which is packed()] to decrypt it.

    $program = &ll0l($AXJXSXOXHXJXGXJXYXJXGXDXRXYXZXXYXZDXFXGXBVXAXQX);
    sub ll0l{
    my($lll)=@_;
    $lll=~s,\+,,gm;
    $lll=~s,\-,,g;
    $lll=~s,\=,,gm;
    $lll=~s,\n,,gm;
    $lll=~s,Z,,gm;
    $lll=~s,X,,gm;
    return(pack('C*',split('l',$lll)));
    }

    then they call

    eval ($program)

    and, thats it!!!


    The sad part is, i explained 'how simple its to decrypt it' to my
    manager and still he want some kind of 'encryption'. So again, am
    stuck!

    So I created two functions, which encrypts and decrypts any file using
    simple 'XOR'ing with a $key logic. Using this encryption algorithm, i
    encrypted all my 48 library files. Then in my main 'index.pl' program,
    i replaced all

    require ("librarynames.pl");

    with my custom requireNow function call

    eval requireNow("encrypted_librarynames.pl");

    and my requireNow function which resides in the index.pl file looks
    something like this

    sub requireNow{
    my($file)=@_;
    open(DAT,"$file");
    my $prog = '';
    {
    my $key = 111;
    local $/;
    $prog = pack "c*",
    map { $_ ^= $key }
    unpack "c*", <DAT>;
    }
    return $prog;
    }

    Then I encrypted the index.pl file with 'Perl Coder', and everything
    was looking fine.

    I called index.pl in web-browser, and it was working most of the time.
    But some times, i was getting errors like

    Undefined subroutine &main::eek:neOfMyFunctions called at (eval 17) line
    9, <DAT> line 3.

    This is how control flows in my program

    program [index.pl]

    #!/C:/perl/perl.exe

    ....

    eval requireNow("encrypted_somecommonlib.pl");
    eval requireNow("encrypted_anothercommonlib.pl");

    .....

    if($q->param("main") eq "one"){
    eval requireNow("encrypted_one_lib.pl");
    &oneFunction1(); # a function inside encrypted_one_lib.pl Working
    fine!
    ...
    }
    elsif($q->param("main") eq "two"){
    &Fun1;
    }
    else{
    ...
    }
    sub Fun1{
    if($q->param("submain")){
    eval requireNow ("encrypted_one_sub.pl");
    &functionIn_one_sub(); # function inside encrypted_one_sub.pl, am
    getting error here! :-(
    }
    else{
    ...
    }
    }

    _____


    So here is my question, is

    eval requireNow("encrypted_one_lib.pl");

    same as

    require "one_lib.pl";

    if not, can some one tell me how to achive the functionality of
    'require' so that, i can decrypt the encrypted perl library file and
    then load it to program.


    thanks in advance,

    Vijoy~
     
    Vijoy Varghese, Jul 9, 2005
    #1
    1. Advertising

  2. I never used, but I like obfuscator.pl. It is not my script, but I am
    attaching it. Try using google to find its home.

    #!/usr/bin/perl
    # RJ's evil obfuscator ALPHA very alpha danger keep yer pants on.
    #$Id: obfuscator.pl,v 1.2 2005/03/31 12:00:16 ichudov Exp $

    my ($v)='v 1.7 2000/02/22 18:53:39';
    my ($debug)=0;
    my ($perldocflag);
    my (@perldoc);

    # read the file
    open FI, $ARGV[0];
    while (my $x=<FI>) {
    if ($x =~ /^\=head/) {
    $perldocflag=1;
    }

    if (!$perldocflag) {
    push @goop,$x;
    } else {
    push @perldoc,$x;
    }

    if ($x =~ /^\=cut/) {
    $perldocflag=0;
    }
    }
    close FI;

    # pass 1 look for all vars/subs
    my(%subroutines);
    my(%variables);

    # A short list of the most popular special variables and one
    # I needed (%FORM) exported for a cgi implementation.
    my(@evilvars)=("ISA","ARGV","_","0","1","2","3","4","5","6","7","8","9","INC","ENV","F","SIG","FORM");

    my ($out,$line,$unquoted);

    foreach my $line (@goop) {
    my(@hits)= ($line =~ /[\$\@\%]\#*\{*([\w:]+)/g);
    foreach (@hits) {
    $variables{$_}=$_;
    }
    my(@hits)= $line =~ /\s*sub\s+(\w+)\s*/g;
    foreach (@hits) {
    $subroutines{$_}=$_;
    }
    }


    # Obfuscate variables with simple substitution via a hash
    # Variables get base 26'ed starting high enough to have a letter a-k
    # I'm still toying with this part. Seems to work, though.
    srand;
    foreach (keys(%variables)) {
    alreadyhavethat:
    $code=lc(BaseConvert(int(rand(182780)+1)+182790,10,26));
    if (in($code,values(%variables))) {
    goto alreadyhavethat;
    }
    # local namespace, only. BTW, not intended for packages yet
    if (!(/::/)) {
    $variables{$_}=$code;
    }
    }

    # Subroutines are simply lettered in sequence, sorry.
    my($i);
    foreach (keys(%subroutines)) {
    $i++;
    $subroutines{$_}=lc(BaseConvert($i+7030,10,26));
    }

    # Fix the variables we didn't really want to rename
    my($i);
    foreach $i(@evilvars) {
    $variables{$i}=$i;
    }


    # Toss it over to a scalar, killing comments
    # Note the caveat... print " I like #5 "; will get killed here...
    foreach $line(@goop) {
    # Kill comments
    $line=~s/(^|[^\$\\\S])\#.*$/$1/;
    $out .= $line;
    }

    @goop = ();

    # Yes, flagrant assumption you like 'NIX.
    # Your line was killed by the comment eater just above here.
    print "\#!/usr/bin/perl\n";
    print "\# THIS FILE has passed through RJ's Perl Obfuscator $v\n\n";
    if ($#perldoc>-1) {
    print @perldoc;
    }
    print stringparse($out);
    exit;

    #########################################################

    sub stringparse {
    my($a)=@_;
    my($out,$work);
    my($l) = length($a);
    # The quote characters in all their glory
    my(@qc)= ("\"","'","`");
    my(@l5,$c,$i);
    my($quoteflag);
    for ($i=0; $i<$l; $i++) {
    $c=substr($a,$i,1);

    # Keep a running 5 last original letters...
    push @l5,$c;
    if (length(@l5>5)) {
    shift @l5;
    }

    if (!$quoteflag) {

    # An actual quote-type character
    $last5=join(undef,@l5);
    # Do we have a quote character?
    if (in($c,@qc) and !$quoteflag) {
    # Should we interpret it as a quote character?
    if (($last5 !~/\\$c$/)) {
    $quotechar=endquotechar($c);
    unless ($c eq "\'") {
    $out.=chopnonquote($work,$quoteflag);
    $quoteflag=1;
    $work=undef;
    } else {
    $out.=chopnonquote($work,$quoteflag);
    $quoteflag=2;
    $work=undef;
    }
    }
    @l5=();
    }

    $last5=join(undef,@l5);
    # Cheat and use the qX hack
    if ($last5 =~ m/[\b\s=(,.]q([^\s\w]{1})/) {
    $quotechar=endquotechar($1);
    $out.=chopnonquote($work,$quoteflag);
    $quoteflag=2;
    $work=undef;
    @l5=();
    }

    $last5=join(undef,@l5);
    # Cheat and use the qqX hack
    if ($last5 =~ m/[\b\s=(,.]qq([^\s\w]{1})/) {
    $quotechar=endquotechar($1);
    $out.=chopnonquote($work,$quoteflag);
    $quoteflag=1;
    $work=undef;
    @l5=();
    }

    $last5=join(undef,@l5);
    if ($last5 =~ m/[\b\s=(,.]qx([^\s\w]{1})/) {
    $quotechar=endquotechar($1);
    $out.=chopnonquote($work,$quoteflag);
    $quoteflag=1;
    $work=undef;
    @l5=();
    }
    # If we are still not in quotes...
    if ($quoteflag<1) {
    # Kill pretty formatting
    # This should really move to chopnonquote...
    if ($c=~/[\s\n\t]/) {
    if (substr($work, length($work)-1,1) eq " ") {
    $c=undef;
    } else {
    $c=" ";
    }
    }
    }
    } else {
    # We are in quotes... can we get out?
    if ($c eq $quotechar) {
    # is it escaped?
    if (!(($l5[($#l5)-1] eq "\\") and ($l5[($#l5)-2] ne "\\"))) {
    $quotechar=undef;
    @l5=();
    $out.=chopnonquote($work,$quoteflag);
    $work=undef;
    $quoteflag=0;
    }
    }
    if ($quoteflag==1) {
    if ($c eq "\n") {
    $c = '\n';
    }
    if ($c eq "\t") {
    $c = '\t';
    }
    }
    }

    $work .= $c;
    }
    $out =~ s/^\s//;
    return $out.chopnonquote($work,$quoteflag);
    }

    sub chopnonquote
    {
    my($work, $mode)=@_;


    # Replace variables
    if ($mode<2) { # was ([\w:]+)
    $work =~ s/([\$\@\%]\#*\{*)([\w]+)/$1$variables{$2}/g;
    }

    # Replace subroutines
    if ($mode==0 and (lc($ARGV[1]) ne 'p')) {
    foreach (keys(%subroutines)) {
    unless ($work =~ /\:$_/) {
    $work =~ s/\b($_)\b/$subroutines{$1}/g;
    }
    }
    }

    if (!$debug) {
    return $work;
    } else {
    return "\n"x($mode==0).$work."\n"x($mode==0);
    #print "[".$work."]<".$mode.">\n";
    return undef;
    }
    }


    sub endquotechar
    {
    my ($qc)=@_;
    if ($qc eq "{") {
    $qc="}";
    }
    if ($qc eq "[") {
    $qc="]";
    }
    if ($qc eq "\(") {
    $qc="\)";
    }
    if ($qc eq "<") {
    $qc=">";
    }
    return $qc;
    }

    ############### NMX.pm ROUTINES swiped to make it portable ################
    ############### WRITTEN BY Nathan Morse ###################################
    ############### Thanks, man! ;^>

    # BaseConvert($number,$FromBase,$ToBase)
    # converts a "number" from one base to another
    # doesn't deal with "decimal" values yet
    sub BaseConvert
    {
    my(%digit);
    my($i,$letter,$from,$to,$n);

    $letter="A";
    for $i(0..35) {
    if ($i<10) {
    $digit{$i}="$i";
    } else {
    $digit{$i}=$letter++;
    }
    }

    ($n,$from,$to)=@_;
    $n=uc$n;
    $n=to10($n,$from,reverse%digit)if($from!=10);
    $n=from10($n,$to,%digit)if($to!=10);
    $n=~s/^0*//;
    if ($n) {
    return$n;
    } else {
    return"0";
    }

    sub from10
    {
    my($n,$to,$nout,%digit);
    $nout="";
    ($n,$to,%digit)=@_;
    while ($n>0) {
    $nout=$digit{$n%$to}.$nout;
    $n=int($n/$to);
    }
    $nout=$n%$to.$nout;
    $n=$n/$to;
    return$nout;
    }

    sub to10
    {
    my($n,$from,$nout,$p,%digit);
    ($n,$from,%digit)=@_;
    for $p(0..(length$n)-1) {
    $nout+=$digit{substr($n,(length$n)-$p-1,1)}*$from**$p;
    }
    return$nout;
    }
    }

    # in($SearchString,$StartPosition,@ArrayToSearch) searches an array for a value
    # returns true if found, or false if not
    sub in
    {
    my($string,@array)=@_;
    my($found)=-1;
    my($element);
    foreach $element(@array) {
    return 1 if($element eq $string);
    }
    return 0;
    }
     
    Ignoramus3635, Jul 9, 2005
    #2
    1. Advertising

  3. Vijoy Varghese

    Mark Guest

    Vijoy Varghese wrote:
    > Hello Group
    >
    >
    > My manager wants me to encrypt/scramble the perl programs I created
    > before delivering to client. I tried to convince him that a 'legal
    > warning' will do the job, but he is not happy, and so is his boss.


    Acme::Bleach?

    warning: make sure you have copies of your script available before using
    this, otherwise you will lose access to the source. Of course, you
    should have all your code in source control, anyway.

    Mark
     
    Mark, Jul 10, 2005
    #3
  4. thanks for the code Ignoramus3635,

    But, what I am looking for is not 'how to encrypt' a perl program. But
    its ....

    How to 'require' a encrypted perl library(a collection of subroutines)
    in a perl program.

    Vijoy~
     
    Vijoy Varghese, Jul 11, 2005
    #4
  5. Acme::Bleach, cool concept!

    But my
    eval reqiureNow( "encrypted_library.pl"); logic is still not working...

    I want to load my encrypted library files into main program. Before
    encryption, it was loaded using the require "library.pl". Now, I need a
    custom 'require' function, because I need to decrypt the libraries
    before loading.

    I created a require function like this
    sub requireNow{
    encrypted code = read encrypted library
    decrypt code
    return decrypted code;
    }

    eval requireNow("encrypted_library.pl");

    and its not 100% working, When i use my 'eval requireNow' function
    inside other functions, in some functions it works, but in some others,
    am getting errors of this form...

    Undefined subroutine &main::eek:neOfMyFunctions called at (eval 17) line
    9, <DAT> line 3.
     
    Vijoy Varghese, Jul 11, 2005
    #5
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Alan Samet
    Replies:
    4
    Views:
    1,936
    Alan Samet
    Jul 17, 2005
  2. Peter
    Replies:
    4
    Views:
    1,981
    Peter
    Jul 14, 2004
  3. Bill
    Replies:
    4
    Views:
    152
    Tad McClellan
    Jan 19, 2004
  4. Replies:
    12
    Views:
    204
    Patrice Auffret
    Sep 23, 2004
  5. Replies:
    2
    Views:
    108
    Gregory Toomey
    Dec 10, 2004
Loading...

Share This Page