# embedIdentityManifest.pl
# Peter Webb, Feb. 2014
# Copyright (C) The MathWorks 2014-2018
#
# Embed an identity manifest in a standalone application or C/C++ shared
# library generated by the MATLAB Compiler. Currently does not support 
# inserting manifests into any other type of MATLAB Compiler-generated
# component.
#
# Usage:
#    perl embedIdentityManifest.pl
#        [-verbose]    : Talk about what you're doing
#        [-keep]       : Retain the temporary directory used for embedding
#        [-supercargo manifest-embedder]  : Full path to embedder
#         binary-file   : Compiler-generated executable to modify

use strict;
use warnings;
use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
use File::Find;
use File::Copy;
use File::Spec;
use File::Basename;
use File::Temp qw( tempfile tempdir );
use File::Basename;
use Env;
use Config;
use XML::LibXML;

#
# Algorithm (if this kind of bookkeeping justifies such a lofty word):
#
# 1. Split the binary component into two parts: the platform-specific
#    wrapper (either a standalone launcher or a shared library API) and
#    the OPC package (zip file) containing the MATLAB functions. Save
#    both parts in a temporary directory.
#
# 2. Extract the contents of the zip file into the temporary directory.
#
# 3. Compute the identity manifest for the contents of the ZIP file.
#
# 4. Create a new ZIP archive with the contents of the original plus the
#    identity manifest.
#
# 5. Reconstruct the component by gluing the platform-specific wrapper and
#    the manifest-containing ZIP archive back together.
# 

# Default base name of the application that embeds an identity manifest into
# a MATLAB Compiler-generated component.
my $exe = $Config{_exe};
my $embedder = "mcc_embed_id_manifest$exe";

# Process command line arguments
my $verbose = 0;
my $keep = 0;
my $debug = 0;
my $ctf = "";
my $supercargo = "";
for (my $k = 0; $k<@ARGV; $k++)
{
    my $arg = $ARGV[$k];
    if ($arg =~ /-verbose/) { $verbose = 1; }
    elsif ($arg =~ /-keep/) { $keep = 1; }
    elsif ($arg =~ /-debug/) { $debug = 1; }
    elsif ($arg =~ /-supercargo/)
    {
        die "-supercargo switch must be followed by full path to manifest embedder, typically $embedder." if ($k+1 >= @ARGV);
        $supercargo = $ARGV[++$k];  # Incrementing loop index. 
    }
    else { $ctf = $arg; }
}

die "Cannot embed manifest in '$ctf' because that file does not exist.\n"
  if (!-e $ctf);

(my $ctfName, my $ctfPath, my $ctfSuffix) = fileparse($ctf);
if (not defined $ctfSuffix) { $ctfSuffix = ""; }
my $wrapperType = wrapperTypeByExtension($ctfSuffix);

# Generate temporary directory for archive extraction and reconstruction.
# By default, directory cleaned up when $fto goes out of scope.
my $tmpDir = tempdir( 'mim_create_XXXXXX', TMPDIR => 1,
                      CLEANUP => ($keep == 0) );

# Correct file separators to UNIX-style
$tmpDir =~ s/\\/\//g;

# Make sure temporary directory was created.
die "Failed to create temporary directory $tmpDir: $!" if (!-d $tmpDir);

my $extractDir = "$tmpDir/extract";
my $partsDir = "$tmpDir/parts";

# CTF archives use OPC to create ZIP files. Therefore we can extract files 
# from CTF archives using plain old ZIP functions.
my $zip = Archive::Zip->new();
unless ( $zip->read( $ctf ) == AZ_OK ) { 
    die "Failed to read CTF archive from $ctf.";
}

# Create a directory in which to save the split apart parts of the application.
# These parts will later be reassembled into the application.
if (! -d $partsDir)
{
    mkdir($partsDir) || die "Could not create parts directory $partsDir: $!";
}
else { die "Parts directory $partsDir unexpectedly exists."; }

# Create a directory in which to extract the contents of the CTF archive.
if (! -d $extractDir)
{
    mkdir($extractDir) ||
      die "Could not create extraction directory $extractDir: $!";
}
else { die "Extraction directory $extractDir unexpectedly exists."; }

printf "Extracting archive to $extractDir.\n" if ($verbose || $keep);

#
# Slice input component into two pieces: the binary wrapper and the CTF archive.
# Depend on ZIP file format, which knows the size of the ZIP archive; the 
# EOCD (end-of-central-directory) offset indicates how far the end of the 
# central directory is from where ZIP thinks it should be, in bytes. Those 
# extra "junk" bytes are exactly the binary wrapper prefixed to the CTF
# archive by the MATLAB Compiler.
# 
open(my $ctfFH, "<", $ctf) ||
  die "Cannot open $ctf to extract wrapper: $!";
binmode $ctfFH;

# Open a file in which to save the bytes of the binary prefix.
my $binPart = "$partsDir/prefix.bin";
open(my $binFH, ">", $binPart) ||
  die "Cannot open wrapper temporary file $binPart: $!";
binmode $binFH;

# How big is the binary wrapper? EOCD occurs at the very end of the ZIP file.
# Usually (from ZIP's point of view) EOCD is zero. But since the MATLAB Compiler
# has prefixed the ZIP file with a platform-specific binary, the EOCD is
# offset by exactly the size of the binary.
my $eocd = $zip->eocdOffset();

# Copy the binary to the save file, $bufMax bytes at a time.
my $totalBytes = 0;
my $bufMax = 4096;
while ($totalBytes != $eocd)
{
    my $remaining = $eocd - $totalBytes;
    # Logical indexing and arrays to implement min()
    my $bufSize =($bufMax, $remaining)[ $bufMax > $remaining ];
    my $bytesRead = read($ctfFH, my $bytes, $bufSize);
    print $binFH $bytes;
    $totalBytes = $totalBytes + $bytesRead;
}
close $binFH;

# After copying the platform-specific binary from the input component, the
# file pointer is left at the very beginning of the zip archive. Open a new
# (temporary) file to store the ZIP archive content.

my $zipPart = "$partsDir/mcc_comparable.zip";
open(my $zipFH, ">", $zipPart) ||
  die "Cannot open ZIP archive temporary file $zipPart: $!";
binmode $zipFH;

# Copy the ZIP content to the new file, $bufMax bytes at a time.
my $bytesRead = 0;
do 
{
    $bytesRead = read($ctfFH, my $bytes, $bufMax);
    print $zipFH $bytes;
} while ($bytesRead == $bufMax);

close $zipFH;
close $ctfFH;

# Extract the content of the ZIP archive to the temporary directory. 
$zip = Archive::Zip->new();
my $zipStatus = $zip->read( $zipPart );
unless ( $zipStatus  == AZ_OK ) { 
    my $zipFailure = zipFailureReason($zipStatus);
    my $causeOfDeath = "Could not read ZIP archive $zipPart: " .
                       $zipFailure . ".";
    die $causeOfDeath;
}

# This EOCD should be zero. If it isn't, there's been some corruption and it's
# all over.
$eocd = $zip->eocdOffset();
die "Failed to divide $ctf into binary prefix and ZIP archive suffix. End of central directory offset: $eocd." if ($eocd != 0);

# Extract the contents of the ZIP archive into the temporary directory. 
# (Linux)         root  dest
$zip->extractTree( '', $extractDir . "/" );

# Check for a pre-existing identity manifest and exit politely if one is 
# already present.
my $idManifest = "$extractDir/metadata/identityManifest.xml";
if (-f $idManifest)
{
    print "$ctf already contains an identity manifest, will not be modified." .
      "\n" if ($verbose);
    exit(0);
}

# Attempting to add a new member after extracting the tree causes an exception.
# Could it be a bug? In free software? No way. But adding a member to a 
# freshly opened archive does seems to work, so I'm stickin' with this, even
# though it seems redundant.
$zip = Archive::Zip->new();
unless ( $zip->read( $zipPart ) == AZ_OK ) { 
    die "Cannot read contents of ZIP archive $zipPart: $!";
}

# Generating the manifest requires some heavy lifting; fortunately the MATLAB
# Compiler libraries have been training for years for this event and are ready
# to go for the gold. But...they only speak C++, so we talk to them through
# an external application, mcc_embed_id_manifest. In order to run this
# application, we need to find it; use environment variables.
#
# But we don't need to look if we've been passed the location via the 
# -supercargo switch.
#
# As a last resort, if there's no -supercargo switch and no MATLAB environment
# variable, look in the directory containing this script.

my $matlabRoot = $ENV{'MATLAB'};
$matlabRoot = $ENV{'MWE_INSTALL'} if (!defined $matlabRoot ||
                                      length($matlabRoot) == 0);

if (length($supercargo) == 0 && defined($matlabRoot))
{
    die "MATLAB root '$matlabRoot' does not exist or is not a directory. Please set MATLAB environment variable to the root directory of the MATLAB installation.\n" if (!-d $matlabRoot);

    my $platform = $ENV{'MWE_ARCH'};
    die "Could not determine platform architecture. Please set MWE_ARCH environment variable." if (!defined($platform) || length($platform) == 0);
   

    # Compute the identity manifest for the extracted archive. Write the new
    # identity manifest file, identity_manifest.xml, into the extracted .META
    # directory.
    my $binDir = $matlabRoot . "/bin/" . $platform;

    die "MATLAB bin directory '$binDir' does not exist or is not a directory. Please set MWE_ARCH environment variable to a the value returned by this MATLAB commmand: computer('arch').\n" if (!-d $matlabRoot);
   if ($platform eq 'glnxa64') {
       if ( -f "/usr/bin/ldd" ) {
           my $lddVersion = `/usr/bin/ldd --version`;
           if ( $lddVersion =~ /\(GNU libc\) 2\.17/ ) {
               $ENV{'LD_PRELOAD'} = $ENV{'LD_PRELOAD'} . ":$binDir/glibc-2.17_shim.so";
           }
       }
   } 
    
    # This is the default 
    $supercargo = "$binDir/$embedder";
}

# Desperate times -- check one last place for the embedder, the directory
# containing this script. That's the actually the most likely location when
# this feature is delivered outside normal distribution channels (i.e. in 
# a ZIP file rather than an actual installer).
if (length($supercargo) == 0)
{
    my $scriptDir = dirname(File::Spec->rel2abs( __FILE__ ));
    $supercargo = "$scriptDir/$embedder"; 
}

# If we couldn't find the external component that embeds the manifest into the
# executable, we can proceed no further.
if (!-e $supercargo)
{
    if (defined($matlabRoot))
    {
        die "The MATLAB installation at '$matlabRoot' does not contain the manifest embedder $embedder. If you are using a release of MATLAB earlier than R14b, try using the -supercargo switch to specify the full path to the embedder.\n"
    }
    die "Manifest embedder '$supercargo' does not not exist.\n";
}

my $sessionKey = extractSessionKey("$extractDir/.META/manifest.xml");
my $cmd = "$supercargo \"$extractDir\" \"$idManifest\" $sessionKey \"$zipPart\"";
print "$cmd\n" if ($debug);
my $output = `$cmd`;
my $status = $?;
if ($status != 0)
{
    my $msg = "Failed to compute identity manifest for '$ctf'.";
    if (length($output) > 0)
    {
        $msg = $msg . "  Reason: \n$output";
    }
    die $msg . "\n";
}


=begin comment
# Compute the extraction-root-relative path to the identity manifest file.
my $relativeManifest = $idManifest;
$relativeManifest =~ s/${extractDir}\///; 

# Add the identity_manifest.xml file to the archive in memory.
my $manifestMember = $zip->addFile($idManifest, $relativeManifest) || die "Failed to add identity manifest $idManifest to ZIP archive as $relativeManifest.";

# Set the compression method and level for all files in the archive, or
# foundation/opc code will refuse to open this archive on Linux. In particular,
# size-zero files need a compression level, even if they are not really 
# compressed.
foreach my $member ($zip->members())
{
    if ($member->uncompressedSize() == 0)
    {
        print $member->fileName() . "\n";
        $member->desiredCompressionMethod( COMPRESSION_DEFLATED );
        $member->desiredCompressionLevel(9);
    }
}

# Save the modified archive to a new temporary ZIP file.
my $idZip = "$tmpDir/mcc_comparable.zip";
$zip->writeToFileNamed($idZip);
=end comment

=cut

# Just in case there's a problem putting Humpty Dumpty back together again,
# use a temporary file.
my $reconstruction = "$tmpDir/$ctfName$ctfSuffix.comparable";

# Copy the binary wrapper prefix to the reconstruction file.
copy($binPart, $reconstruction) ||
  die "Failed to copy $wrapperType to temporary reconstruction file " .
      "$reconstruction: $!";

# Open the reconstruction file for append, and copy the bytes of the modified
# ZIP archive to the end of the reconstruction file.
open (my $hdFH, ">>", $reconstruction) ||
  die "Cannot append to temporary reconstruction file $reconstruction: $!";
binmode $hdFH;

open($zipFH, "<", $zipPart) || die "Cannot open $zipPart for read: $!";
binmode $zipFH;

# Copy $bufMax bytes at a time.
$bytesRead = 0;
do 
{
    $bytesRead = read($zipFH, my $bytes, $bufMax);
    print $hdFH $bytes;
} while ($bytesRead == $bufMax);

close $zipFH;
close $hdFH;

# Overwrite the input binary with the newly comparable binary only if
# everything else went perfectly. 
copy($reconstruction, $ctf) ||
  die "Failed to copy reconstructed component with embedded manifest to original $ctf. Could not overwrite original with binary $reconstruction.";

#
# The End
# 

# Extract the encrypted session key from the CTF archive metadata.
# Return it as a string.
sub extractSessionKey 
{
    my $ctfManifest = shift;

    die "Could not locate archive manifest $ctfManifest"
      if (!-f $ctfManifest);

    my $parser = XML::LibXML->new();
    my $doc = $parser->parse_file($ctfManifest);

    die "Could not parse archive manifest $ctfManifest"
      if (! $doc);

    my $keyNode = $doc->findnodes("/manifest/configuration/session-key");

    die "Could not locate session key in archive manifest $ctfManifest"
      if (! $keyNode);

    $keyNode->to_literal
}

sub usage
{
    print "Usage: \n";
    print "$0 [-verbose] [-keep] executable-or-shared-library";
}

sub zipFailureReason
{
    my $errCode = shift;
    my $reason = "Error or errors unknown";
    if ($errCode == AZ_FORMAT_ERROR)
      { $reason = "Badly formatted ZIP archive"; }
    elsif ($errCode == AZ_IO_ERROR)
      { $reason = "Non-specific I/O error (network glitch?)"; }

    $reason;
}

sub wrapperTypeByExtension
{
    my $ext = shift;
    # UNIX executables have no extension...
    my $type = "executable";
    if ($ext =~ /\.[Dd][Ll][Ll]/ ||
        $ext =~ /\.[Ss][Oo]/ ||
        $ext =~ /\.[Dd][Yy][Ll][Ii][Bb]/)
      {
          $type = "library";
      }
    $type;
}
