linux-packaging-mono/debian/mono.runtime-script
2014-11-05 11:48:44 +00:00

279 lines
7.3 KiB
Perl
Raw Permalink Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

#!/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 $_;
}