mono-gac 4.6.2.7+dfsg-1ubuntu1 / usr / share / cli-common / runtimes.d / mono

#!/usr/bin/perl

#
# Setup
#

# Directives
use strict;
use warnings;
use File::Basename;

# Figure out the mode
my $mode = shift @ARGV;

my $framework_prefix = "/usr/lib/mono";

if (!defined $mode)
{
    print STDERR "E: You must supply a mode\n";
    print STDERR "E: Use: install-framework, install, remove-framework, remove, or name\n";
    exit 1;
}

# Name is simply
if ($mode eq "name")
{
    print "Mono\n";
    exit 0;
}

# Get the base directory
my $basedir = "/usr/share/cli-common/packages.d/";
# Get the base file
my $basename = shift @ARGV;

# We're looking to install a framework
# The program gets the name of the package, then a list of 
# the (framework version×10, full path) pairs
if ($mode eq "install-framework")
{
    # TODO: We could detect this ourselves
    my %runtime_versions = (20 => "$framework_prefix/2.0",
			    35 => "$framework_prefix/3.5",
			    40 => "$framework_prefix/4.0", 
			    45 => "$framework_prefix/4.5");

    my $uninstall = "$basedir/$basename.mono-framework";

    open UNINSTALL, ">$uninstall"
	or die "E: Cannot open uninstall: $uninstall";

    while (@ARGV)
    {
	my $framework_ver = int(shift @ARGV);
	my $dll = shift @ARGV;

	if (! exists($runtime_versions{$framework_ver}))
	{
	    printf STDERR "W: Attempted to install framework library for unsupported version $framework_ver";
	    next;
	}

	my $target = "$runtime_versions{$framework_ver}/" . basename($dll);
	
	if (-f $target)
	{
	    # Ensure we're idempotent
	    unlink $target;
	}

	symlink $dll, $target
	    or die "E: Unable to install $dll into framework path: $target\n";
	print UNINSTALL "$target\n";
    }
    close UNINSTALL;
    exit 0;
}

# Removing is also simple
if ($mode eq "remove-framework")
{
    # Get the uninstall file
    my $uninstall = "$basedir/$basename.mono-framework";

    if (-f $uninstall)
    {
	# Go through the file
	open UNINSTALL, "<$uninstall" or
	    die "E: Cannot open uninstall file ($!)";

	while (<UNINSTALL>)
	{
	    chomp;
	    unlink($_) or
		printf STDERR "E: Unable to remove $_\n";
	}

	close UNINSTALL;
	unlink($uninstall);
    }

    # We are good
    exit 0;
}

# This program gets the name of a file (ending in .installcligac) and
# a list of assemblies to install, as full paths. The ones given are
# the only ones that passed the white/blacklisting.

my $cligac = "/usr/share/cli-common/packages.d/$basename.installcligac";

if (! -f $cligac)
{
    print STDERR "E: File does not exist: $cligac\n";
    exit 1;
}

# Removing is also simple
if ($mode eq "remove")
{
    # Get the uninstall file
    my $uninstall = "$basedir/$basename.mono";

    if (-f $uninstall)
    {
	# Go through the file
	open UNINSTALL, "<$uninstall" or
	    die "E: Cannot open uninstall file ($!)";

	while (<UNINSTALL>)
	{
		my $assembly = $_;
		chomp($assembly);
		# The uninstall file can contain two formats - full paths to non-assembly entries
		# (i.e. FSharp sigdata/optdata files), or assembly signature stuff in the format
		# "name, Version=x.x.x.x, Culture=neutral, PublicKeyToken=yyyyyyyyyyyyy"
		#
		# We can switch behaviour, based on whether it is a path or not (if it is a path,
		# it has a leading /)
		#
		# If it's not a path, pass the entry to gacutil to uninstall
		if ($assembly !~ /^\//)
		{
		    my $cmd = "/usr/bin/gacutil -u $assembly > /dev/null";
		    my $res = system($cmd);
		    if ($res > 0) {
			print STDERR "W: removing assembly: $assembly failed!\n";
		    }
		}
		# If it is a path, unlink.
		#
		# This is often not actually needed - if a parent assembly is uninstalled
		# from the GAC, the sigdata/optdata files are cleaned automatically
		#
		# We manually unlink if these files are specifically named anyway, in case
		# we ever want to keep companion files in different packages (where they would
		# not be uninstalled by the same GAC cleaning run)
		else
		{
		    # Definitely a link, unlink it please
		    if (-l "$assembly")
		    {
			unlink $assembly;
		    }
		    # The file exists, but is not a link, which means we didn't put it
		    # there, so panic!
		    elsif (-f "$assembly")
		    {
			print STDERR "W: removing non-assembly file: $assembly failed!\n";
		    }
		    # If the file doesn't exist, we do nothing - we don't WANT it to exist
		}
	}

	close UNINSTALL;

	# Unlike the file
	unlink($uninstall);
    }

    # We are good
    exit 0;
}

# The only thing left should be "install"
if ($mode ne "install")
{
    print STDERR "E: Unknown mode: $mode\n";
    print STDERR "E: Use: install-framework, install, remove-framework,  remove or name\n";
    exit 1;
}


# Open up our uninstall file
open UNINSTALL, ">$basedir/$basename.mono"
    or die "E: Cannot open uninstall: $basedir/$basename.mono";

# Go through the file
open CLIGAC, "<$cligac" or die "E: Cannot open: $cligac ($!)";

while (@ARGV)
{
    # Get the assembly name
    my $dll = shift @ARGV;
    
    # Make sure it is there
    if (! -f $dll)
    {
	print STDERR "E: Assembly does not exist: $dll\n";
	exit 1;
    }	
    
    # Split the provided assembly path into its components - folder, basename, and suffix.
    # All three are useful
    my($assemblyfilename, $assemblypath, $assemblysuffix) = (fileparse($dll, qr/\.[^.]*/));

    # If the suffix is .dll, assume this is a simple CLI assembly, and use gacutil for
    # processing
    if (( $assemblysuffix eq ".dll" ) || ( $assemblysuffix eq ".exe" ))
    {
	# Figure out the mono's precise name
	my $fullname = get_full_name($dll);

	# Write out the uninstall file
	print UNINSTALL "$fullname\n";

	# Install the file. We use the "../../../.." to make it a
	# relative path to this program (since gacutil doesn't like
	# absolute paths). There isn't a problem of doing too many
	# since we typically run from the root context.
	my $cmd = "(cd `dirname $dll` && "
	    . "/usr/bin/gacutil -i `basename $dll`"
	    . " > /dev/null)";
	system($cmd) == 0 or die "E: installing Assembly $dll failed\n";
    }
    else
    {
	# If the extension is not .dll, this is some other file format (e.g. FSharp
	# sigdata/optdata) and we cannot use gacutil.
	#
	# First, we determine the path of the assembly which accompanies this data file
	my $parentassembly = "$assemblypath$assemblyfilename.dll";
	# Then extract the assembly information from this "parent" assembly, such as the
	# version and signing token
	my $fullname = get_full_name($parentassembly);
	my($parentname, $parentver, $parentculture, $parenttoken) = split(/, [a-zA-z]*=/, $fullname);
	# And finally, we construct a path to where we know Mono will GAC-install the
	# parent assembly, and put a symlink in there
	my $targetpath = "$framework_prefix/gac/$parentname/$parentver\__$parenttoken/$assemblyfilename$assemblysuffix";
	symlink($dll, $targetpath);
	# And write the path to the symlink into the uninstall file
	print UNINSTALL "$targetpath\n";
    }
}

close CLIGAC;
close UNINSTALL;

# Finish up successfully
exit 0;

# Get the name of the assembly in a manner suitable for uninstall
# using gacutil.
sub get_full_name
{
    # Get the name
    my $dll = shift;

    # Open a pipe to monop
    my $cmd = "LANG=C /usr/bin/mono /usr/share/mono/MonoGetAssemblyName.exe $dll";
    open PIPE, "$cmd |" or die "E: Cannot open pipe to assembly builder $dll";

    # This generate a single line that produces the desired results
    $_ = <PIPE>;
    chomp;
	 # assembly1, Version=1.0.0.0, Culture=en, PublicKeyToken=0123456789abcdef
    return $_;
}