replicate.pl

replicate.pl

#!/usr/bin/perl
#  Self-referencing, static-data permuting bizneratch-o-fun
#
#  Writes a copy of itself out to STDOUT, and executes
#  $payload (which currently writes to STDERR.
#
#  For best results:
#  $ ./replicate.pl > replicate.dup
#
#  prole@subterrain.net
#  _p
#

# First big static data chunk:
##### Begin self definition #####
my $self = '#!/usr/bin/perl
my $self = %c%s%c;
my ($dq,$sq,$perc,$c,$esc) = (0x22,0x27,0x25,0x63,0x5c);
my $a2o = sub { sprintf "%c.3o", $_[0]; };

my $cself;
my $s_used_str;
my $s_used = { %s };
my $s_shift_str;
my $s_shift = %s;

($self,$cself,$s_used_str,$s_shift_str) = &obfuscate( $self,
                                                      $s_used,
                                                      $s_used_str,
                                                      $s_shift     );

my $payload = %c%s%c;

my $cpayload;
my $p_used_str;
my $p_used = { %s };
my $p_shift_str;
my $p_shift = %s;

($payload,$cpayload,$p_used_str,$p_shift_str) = &obfuscate( $payload,
                                                            $p_used,
                                                            $p_used_str,
                                                            $p_shift     );

print sprintf $self, $sq, $cself, $sq, $perc, 
              $s_used_str, $s_shift_str, $sq, 
              $cpayload, $sq, $p_used_str, $p_shift_str;

my $quotes = chr($perc).chr($c);
$payload =~ s/$quotes/chr($sq)/ge;

eval $payload;

exit;

sub obfuscate {
   my ($data,$used,$used_str,$shift) = @_;

   my ($cdata,$shift_str);
   my @data = split //, $data;

   if( scalar( keys %$used ) > 1 ) {
      $data = "";
      foreach my $char ( @data ) {
         $data .= $char if $used->{$char};
      }
      @data = split //, $data;
   }

   if( $shift ) {
      $data = "";
      foreach my $char ( @data ) {
         $data .= chr((ord($char)-$shift)%256);
      }
      @data = split //, $data;
   }

   my $new_shift = int(1+rand(255));
   my @pdata = split //, $data;
   while( @pdata ) {
      my $char = shift(@pdata);
      my $nchr = chr((ord($char)+$new_shift)%256);
      if( $nchr eq chr($esc) || $nchr eq chr($sq) ) {
         $cdata .= chr($esc);
      }
      $cdata .= $nchr;
   }
   $shift_str = "$new_shift";

   @pdata = split //, $cdata;
   %$used = map { $_ => 1 } @pdata;
   map { 
      my $oct = $a2o->(ord($_));
      $used_str .= chr($dq).chr($esc)."$oct".chr($dq)." => 1, ";
   } keys %$used;

   @pdata = split //, $cdata;
   $cdata = "";
   while( @pdata ) {
      my $bit = int(rand(2));
      if( $bit ) {
         my $rchar = chr(int(rand(256)));
         while( $used->{$rchar} 
                || $rchar eq chr($sq) 
                || $rchar eq chr($esc) ) {
            $rchar = chr(int(rand(256)));
         }
         $cdata .= $rchar;
      }

      next if int(rand(2));

      my $char = shift(@pdata);
      if( $char eq chr($esc) ) {
         $cdata .= $char;
         $cdata .= shift(@pdata);
      } else {
         $cdata .= $char;
      }
   }

   return ($data,$cdata,$used_str,$shift_str);
}

';
##### End self definition #####

# useful definitions
my ($dq,$sq,$perc,$c,$esc) = (0x22,0x27,0x25,0x63,0x5c);

# sprintf: typical way to references ourselves, but here we're just
# defining this to avoid having to use a percent (%) sign in obfuscate(), 
# which has to appear in $self at the end ('cause that's where I put it), 
# and therefore % would be treated as a undefined hash in the clone if we 
# didn't sprintf() an extra $perc$c for it.  That' difficult just 'cause
# I think it's ugly to have perl functions at strung throught lexical codeflow.
my $a2o = sub { sprintf "%.3o", $_[0]; };

my $cself;

# We declare one and assinged it to the other so that on the
# first invocation, we will be initialized to 'undef', and on future
# clones, we'll actually have some data there.
my $s_used_str;
my $s_used = { $s_used_str };
my $s_shift_str;
my $s_shift = $s_shift_str;

($self,$cself,$s_used_str,$s_shift_str) = &obfuscate( $self,
                                                      $s_used,
                                                      $s_used_str,
                                                      $s_shift     );

# Define me!
my $payload = '
   print STDERR "\nI%cm a copy\n\n";
';

# Do this stuff again for the payload
my $cpayload;
my $p_used_str;
my $p_used = { $p_used_str };
my $p_shift_str;
my $p_shift = $p_shift_str;

($payload,$cpayload,$p_used_str,$p_shift_str) = &obfuscate( $payload,
                                                            $p_used,
                                                            $p_used_str,
                                                            $p_shift     );

# Now sprintf() ourselves out a new clone.
print sprintf $self, $sq, $cself, $sq, $perc, 
              $s_used_str, $s_shift_str, $sq, 
              $cpayload, $sq, $p_used_str, $p_shift_str;

# Replace all occurances of "%c" in $payload with (')
my $quotes = chr($perc).chr($c);
$payload =~ s/$quotes/chr($sq)/ge;

# Exec the payload
eval $payload;

exit;

sub obfuscate {
   my ($data,$used,$used_str,$shift) = @_;

   my ($cdata,$shift_str);
   my @data = split //, $data;

   # If there's data in $used, i.e., we're a clone and have been permuted,
   # remove the bogus data.
   if( scalar( keys %$used ) > 1 ) {
      $data = "";
      foreach my $char ( @data ) {
         $data .= $char if $used->{$char};
      }
      @data = split //, $data;
   }

   # If there's data in $shift, i.e., we're a clone and have been shifted,
   # unsift
   if( $shift ) {
      $data = "";
      foreach my $char ( @data ) {
         $data .= chr((ord($char)-$shift)%256);
      }
      @data = split //, $data;
   }

   # Create a new random shift amount, and shift everything.  Make sure that
   # anything that gets shifted to an escape (\) gets escaped itself, so 
   # whatever's next doesn't get escaped on accident.  Also make sure we escape
   # any single quotes, as that would terminate the data string in the clone.
   my $new_shift = int(1+rand(255));
   my @pdata = split //, $data;
   while( @pdata ) {
      my $char = shift(@pdata);
      my $nchr = chr((ord($char)+$new_shift)%256);
      if( $nchr eq chr($esc) || $nchr eq chr($sq) ) {
         $cdata .= chr($esc);
      }
      $cdata .= $nchr;
   }
   $shift_str = "$new_shift";

   # Create the hash of critical data that's been shifted, so we (and the clone)
   # know what to keep.  We also translate the declaration string values to 
   # octal, to avoid problems w/ escape characters, etc.
   @pdata = split //, $cdata;
   %$used = map { $_ => 1 } @pdata;
   map { 
      my $oct = $a2o->(ord($_));
      $used_str .= chr($dq).chr($esc)."$oct".chr($dq)." => 1, ";
   } keys %$used;

   # Now, take the shifted data, and insert random lengths of chaff data at 
   # random intervals.  Make sure the chaff data isn't the same as shifted valid
   # data, as that would interfere w/ decoding.  Also, make sure it's not an
   # escape or single quote, to avoid premature corruption or termination.  :O
   # Could have allowed them and escaped them, this was just easier.
   @pdata = split //, $cdata;
   $cdata = "";
   while( @pdata ) {
      my $bit = int(rand(2));
      if( $bit ) {
         my $rchar = chr(int(rand(256)));
         while( $used->{$rchar} 
                || $rchar eq chr($sq) 
                || $rchar eq chr($esc) ) {
            $rchar = chr(int(rand(256)));
         }
         $cdata .= $rchar;
      }

      next if int(rand(2));

      my $char = shift(@pdata);
      if( $char eq chr($esc) ) {
         $cdata .= $char;
         $cdata .= shift(@pdata);
      } else {
         $cdata .= $char;
      }
   }

   return ($data,$cdata,$used_str,$shift_str);
}