#!/usr/bin/perl

# perlc v.2.0
# Compile Perl script to statically linked relocatable executable and
# copy its modules in a relative-path 'lib' folder.
# Authors:
# David Ljung Madison <marginalhacks.com/Hacks/perlc/>
# Dimitar D. Mitov <github.com/ddmitov>
# License: http://MarginalHacks.com/License/

use strict;
use warnings;
use 5.010;

use Cwd qw(abs_path getcwd);
use ExtUtils::Embed;
use File::Basename qw(fileparse);
use File::Find;
use File::Spec::Functions qw(catdir);
use FindBin qw($Bin);
use Getopt::Long qw(GetOptions);
use MIME::Base64;

use lib catdir($Bin, "perlclib", "perl");

# Non-core CPAN modules:
# File::Copy::Recursive and Module::ScanDeps are loaded from
# the 'perlclib/perl' subdirectory of the directory of this script:
use File::Copy::Recursive qw(fcopy);
use Module::ScanDeps;

# Get help:
if ($ARGV[0] and $ARGV[0] =~ /^--help$/) {
  help();
}

# Get command-line arguments:
my $script;
my $libperl;
my $encryption;
my $disk_serial;
my $mac;
my $bleach;
my $no_compilation;

GetOptions("script=s" => \$script,
            "libperl=s" => \$libperl,
            "disk-serial=s" => \$disk_serial,
            "mac=s" => \$mac,
            "bleach" => \$bleach,
            "no-compilation" => \$no_compilation);

my $script_full_path = abs_path($script);
my $script_full_name = fileparse($script_full_path);
my($script_name, $script_directory, $script_suffix) =
  fileparse($script_full_path, ".pl");

# Missing script name:
unless ($script) {
  help("Missing Perl script name!");
}

if ($disk_serial or $mac) {
  $encryption = 1;
}

# Find 'libperl.a':
unless ($libperl) {
  foreach my $perl_include_folder (@INC) {
    if (-d $perl_include_folder) {
      find(sub {
        if (-f $File::Find::name and /^libperl.*.a$/) {
          $libperl = $File::Find::name;
        }
      }, $perl_include_folder);
    }
  }
}

unless ($libperl) {
  help("Unable to find Perl library for static linking!\n".
        "Use the '--libperl' argument to enter full path to 'libperl.a'");
}

print "\nGoing to use:\n";
print "'$libperl'\n";

# Get script contents:
my $perl_code;
unless ($encryption) {
  open my $script_filehandle, '<', $script_full_path or
    help("Unable to open Perl script: $script_full_path");
  $/ = undef;
  $perl_code = <$script_filehandle>;
  close $script_filehandle;
}

# Executable file name:
my $executable = $script_name;

# C source file name:
my $c_source_file = $script_name.".c";

# C source file, executable and a relative-path 'lib' folder
# are created in a new directory:
my $executable_folder = $executable."-bin";
my $lib_folder = catdir(getcwd(), $executable_folder, "lib");

my $c_matrix_path;
my $c_source_path = catdir(getcwd(), $executable_folder, $c_source_file);

if ($encryption) {
  my $aes_h_original = catdir($Bin, "perlclib", "c", "aes256.h");
  my $aes_c_original = catdir($Bin, "perlclib", "c", "aes256.c");
  my $aes_h_copy = catdir(getcwd(), $executable_folder, "aes256.h");
  my $aes_c_copy = catdir(getcwd(), $executable_folder, "aes256.c");
  fcopy($aes_h_original, $aes_h_copy);
  fcopy($aes_c_original, $aes_c_copy);

  my $cryptor_original;
  my $cryptor_copy;

  if ($disk_serial) {
    $cryptor_original = catdir($Bin, "perlclib", "c", "disk-serial-cryptor.c");
    $cryptor_copy = catdir(getcwd(), $executable_folder, "cryptor.c");
    fcopy($cryptor_original, $cryptor_copy);

    $c_matrix_path =
      catdir($Bin, "perlclib", "c", "disk-serial-encryption-matrix.c");
    fcopy($c_matrix_path, $c_source_path);
  }

  if ($mac) {
    $cryptor_original = catdir($Bin, "perlclib", "c", "mac-cryptor.c");
    $cryptor_copy = catdir(getcwd(), $executable_folder, "cryptor.c");
    fcopy($cryptor_original, $cryptor_copy);

    $c_matrix_path =
      catdir($Bin, "perlclib", "c", "mac-encryption-matrix.c");
    fcopy($c_matrix_path, $c_source_path);
  }
}

unless ($encryption) {
  my $base64_h_original = catdir($Bin, "perlclib", "c", "b64.h");
  my $base64_c_original = catdir($Bin, "perlclib", "c", "b64-decode.c");
  my $base64_h_copy = catdir(getcwd(), $executable_folder, "b64.h");
  my $base64_c_copy = catdir(getcwd(), $executable_folder, "b64-decode.c");
  fcopy($base64_h_original, $base64_h_copy);
  fcopy($base64_c_original, $base64_c_copy);

  my $c_matrix_path = catdir($Bin, "perlclib", "c", "matrix.c");
  fcopy($c_matrix_path, $c_source_path);
}

# Get all script dependencies and
# copy them in the relative-path 'lib' folder:
print "\nScanning dependencies...\n";
my $dependencies =
  scan_deps (files => [$script_full_path], recurse => 3, compile => 'true');

my $module_counter;
while (my($partial_path, $module) = each(%{$dependencies})) {
  foreach my $include_path (@INC) {
    unless ($partial_path =~ $script_full_name) {
      my $module_full_path = catdir($include_path, $partial_path);
      if (-e $module_full_path) {
        $module_counter++;
        print "Dependency Nr. $module_counter: $module_full_path";
        fcopy($module_full_path, catdir($lib_folder, $partial_path));
        print " ... copied.\n";
      }
    }
  }
}

# Obfuscate script code using PAR::Filter::Bleach
# if the --bleach command-line argument is used and
# PAR::Filter::Bleach is available:
if ($bleach) {
  if (eval("require PAR::Filter::Bleach;")) {
    require PAR::Filter::Bleach;
    PAR::Filter::Bleach->import();
    PAR::Filter::Bleach->apply(\$perl_code);
    print "\nPerl script is successfully obfuscated.\n";
  } else {
    print "\nPAR::Filter::Bleach module is missing in this Perl distribution.\n";
  }
}

# Change the working directory to the directory of the executable:
chdir $executable_folder;

# Compile command:
my $ccopts = ccopts(0);
my $ldopts = ldopts(0);
$ldopts =~ s/ -lperl / $libperl /;

my $compile_command;
if ($encryption) {
  $compile_command =
    "gcc -Wall -o $executable $c_source_file aes256.c $ccopts $ldopts";
}

unless ($encryption) {
  $compile_command =
    "gcc -Wall -o $executable $c_source_file b64-decode.c $ccopts $ldopts";
}

print "\nCompile command:\n";
print "$compile_command\n\n";

# Get DynaLoader code:
my $dyna_loader = `perl -MExtUtils::Embed -e xsinit -- -o STDOUT`;
unless ($dyna_loader && $? == 0) {
  print STDERR "\nPerl 'xsinit' command failed:\n$?\n\n";
  exit(1);
}

if ($encryption) {
  my $cryptor_compilation = `gcc -Wall aes256.c cryptor.c -o cryptor`;
}

# Convert Perl source code to C char variable:
my $perl_char_code;

if ($encryption) {
  $perl_char_code = "uint8_t script[] =\n{";

  my $cryptor_full_path = catdir(getcwd(), "cryptor");

  my $encrypted_code;
  if ($encryption) {
    if ($disk_serial) {
      $encrypted_code = `$cryptor_full_path $script_full_path $disk_serial`;
    }

    if ($mac) {
      $encrypted_code = `$cryptor_full_path $script_full_path $mac`;
    }
  }

  $encrypted_code =~ s/,\s$//;
  $perl_char_code = $perl_char_code.$encrypted_code."};";
}

unless ($encryption) {
  my $base64_perl_code = encode_base64($perl_code);
  $base64_perl_code =~ s/\n/\"\n\"/g;
  $base64_perl_code =~ s/\"\n\"$/\"/;
  $perl_char_code = "const char *script =\n\"".$base64_perl_code.";";
}

# C source code composition:
my $c_source_filehandle;
my $c_source;
{
  open $c_source_filehandle, '<', $c_source_path or
    help("Unable to open C file for reading: $c_source_path");
  $/ = undef;
  $c_source = <$c_source_filehandle>;
  close $c_source_filehandle;
}

$c_source =~ s/\/\/COMPILE-COMMAND\/\//$compile_command/;
$c_source =~ s/\/\/DYNALIB\/\//$dyna_loader/;
$c_source =~ s/\/\/SCRIPT\/\//$perl_char_code/;

open $c_source_filehandle, '>', $c_source_path or
  help("Unable to open C source file for writing: $c_source_path");
print $c_source_filehandle $c_source;
close $c_source_filehandle;

print "C source files are successfully created.\n\n";

# Compile the executable:
unless ($no_compilation) {
  system($compile_command);
  unless ($?) {
    print "Perl script is successfully compiled.\n\n";
  }
}

# Help:
sub help {
  foreach my $msg (@_) {
    print STDERR "\n$msg\n";
  }

  print STDERR <<HELP;

perlc v.2.0
Compile Perl script to statically linked relocatable executable and
copy its modules in a relative-path 'lib' folder.
Author: David Ljung Madison <marginalhacks.com/Hacks/perlc/>
Contributor: Dimitar D. Mitov <github.com/ddmitov>
License: http://MarginalHacks.com/License/

Usage:
$0 --script=<script> <arguments>

Arguments:
--script=<perl-script-name-or-full-path>
  This argument is mandatory.
--libperl=<path>
  Full path to 'libperl.a' - the Perl library for static linking.
  Use this argument if 'libperl.a' is outside of your \@INC folders.
--disk-serial=<disk-device-serial-number>
  Perl script encryption using the serial number of the current disk as a key.
  'current' means the serial number of the disk where the script is compiled.
--mac=<mac-address>
  Perl script encryption using the first MAC address as a key.
  'current' means the first MAC address of the current machine.
--bleach
  Perl script obfuscation using the PAR::Filter::Bleach module.
  PAR::Filter::Bleach obfuscation is aplicable only if no encryption is used.
--no-compilation
  Only C source files are created, but no compilation is performed.
--help
  this help

HELP
  exit (1);
}
